]> www.ginac.de Git - ginac.git/commitdiff
New branch "experimental_fclasses" created for testing new function system.
authorJens Vollinga <vollinga@thep.physik.uni-mainz.de>
Wed, 19 Apr 2006 21:18:35 +0000 (21:18 +0000)
committerJens Vollinga <vollinga@thep.physik.uni-mainz.de>
Wed, 19 Apr 2006 21:18:35 +0000 (21:18 +0000)
29 files changed:
check/exam_indexed.cpp [new file with mode: 0644]
check/exam_pseries.cpp [new file with mode: 0644]
ginac/Makefile.am
ginac/flags.h
ginac/function.cpp [new file with mode: 0644]
ginac/function.h [new file with mode: 0644]
ginac/function.pl [deleted file]
ginac/ginac.h
ginac/inifcns.cpp
ginac/inifcns.h
ginac/inifcns_exp.cpp [new file with mode: 0644]
ginac/inifcns_exp.h [new file with mode: 0644]
ginac/inifcns_gamma.cpp [deleted file]
ginac/inifcns_polylog.cpp [new file with mode: 0644]
ginac/inifcns_polylog.h [new file with mode: 0644]
ginac/inifcns_trans.cpp [deleted file]
ginac/inifcns_trig.cpp [new file with mode: 0644]
ginac/inifcns_trig.h [new file with mode: 0644]
ginac/input_parser.yy [new file with mode: 0644]
ginac/integral.cpp [new file with mode: 0644]
ginac/matrix.cpp
ginac/normal.cpp
ginac/power.cpp
ginac/pseries.cpp [new file with mode: 0644]
ginac/registrar.cpp [new file with mode: 0644]
ginac/registrar.h [new file with mode: 0644]
ginac/symbol.cpp
ginac/symmetry.cpp [new file with mode: 0644]
ginsh/ginsh_parser.yy

diff --git a/check/exam_indexed.cpp b/check/exam_indexed.cpp
new file mode 100644 (file)
index 0000000..dcfa0ae
--- /dev/null
@@ -0,0 +1,449 @@
+/** @file exam_indexed.cpp
+ *
+ *  Here we test manipulations on GiNaC's indexed objects. */
+
+/*
+ *  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 "exams.h"
+
+static unsigned check_equal(const ex &e1, const ex &e2)
+{
+       ex e = e1 - e2;
+       if (!e.is_zero()) {
+               clog << e1 << "-" << e2 << " erroneously returned "
+                    << e << " instead of 0" << endl;
+               return 1;
+       }
+       return 0;
+}
+
+static unsigned check_equal_simplify(const ex &e1, const ex &e2)
+{
+       ex e = simplify_indexed(e1) - e2;
+       if (!e.is_zero()) {
+               clog << "simplify_indexed(" << e1 << ")-" << e2 << " erroneously returned "
+                    << e << " instead of 0" << endl;
+               return 1;
+       }
+       return 0;
+}
+
+static unsigned check_equal_simplify(const ex &e1, const ex &e2, const scalar_products &sp)
+{
+       ex e = simplify_indexed(e1, sp) - e2;
+       if (!e.is_zero()) {
+               clog << "simplify_indexed(" << e1 << ")-" << e2 << " erroneously returned "
+                    << e << " instead of 0" << endl;
+               return 1;
+       }
+       return 0;
+}
+
+static unsigned delta_check()
+{
+       // checks identities of the delta tensor
+
+       unsigned result = 0;
+
+       symbol s_i("i"), s_j("j"), s_k("k");
+       idx i(s_i, 3), j(s_j, 3), k(s_k, 3);
+       symbol A("A");
+
+       // symmetry
+       result += check_equal(delta_tensor(i, j), delta_tensor(j, i));
+
+       // trace = dimension of index space
+       result += check_equal(delta_tensor(i, i), 3);
+       result += check_equal_simplify(delta_tensor(i, j) * delta_tensor(i, j), 3);
+
+       // contraction with delta tensor
+       result += check_equal_simplify(delta_tensor(i, j) * indexed(A, k), delta_tensor(i, j) * indexed(A, k));
+       result += check_equal_simplify(delta_tensor(i, j) * indexed(A, j), indexed(A, i));
+       result += check_equal_simplify(delta_tensor(i, j) * indexed(A, i), indexed(A, j));
+       result += check_equal_simplify(delta_tensor(i, j) * delta_tensor(j, k) * indexed(A, i), indexed(A, k));
+
+       return result;
+}
+
+static unsigned metric_check()
+{
+       // checks identities of the metric tensor
+
+       unsigned result = 0;
+
+       symbol s_mu("mu"), s_nu("nu"), s_rho("rho"), s_sigma("sigma");
+       varidx mu(s_mu, 4), nu(s_nu, 4), rho(s_rho, 4), sigma(s_sigma, 4);
+       symbol A("A");
+
+       // becomes delta tensor if indices have opposite variance
+       result += check_equal(metric_tensor(mu, nu.toggle_variance()), delta_tensor(mu, nu.toggle_variance()));
+
+       // scalar contraction = dimension of index space
+       result += check_equal(metric_tensor(mu, mu.toggle_variance()), 4);
+       result += check_equal_simplify(metric_tensor(mu, nu) * metric_tensor(mu.toggle_variance(), nu.toggle_variance()), 4);
+
+       // contraction with metric tensor
+       result += check_equal_simplify(metric_tensor(mu, nu) * indexed(A, nu), metric_tensor(mu, nu) * indexed(A, nu));
+       result += check_equal_simplify(metric_tensor(mu, nu) * indexed(A, nu.toggle_variance()), indexed(A, mu));
+       result += check_equal_simplify(metric_tensor(mu, nu) * indexed(A, mu.toggle_variance()), indexed(A, nu));
+       result += check_equal_simplify(metric_tensor(mu, nu) * metric_tensor(mu.toggle_variance(), rho.toggle_variance()) * indexed(A, nu.toggle_variance()), indexed(A, rho.toggle_variance()));
+       result += check_equal_simplify(metric_tensor(mu, rho) * metric_tensor(nu, sigma) * indexed(A, rho.toggle_variance(), sigma.toggle_variance()), indexed(A, mu, nu));
+       result += check_equal_simplify(indexed(A, mu.toggle_variance()) * metric_tensor(mu, nu) - indexed(A, mu.toggle_variance()) * metric_tensor(nu, mu), 0);
+       result += check_equal_simplify(indexed(A, mu.toggle_variance(), nu.toggle_variance()) * metric_tensor(nu, rho), indexed(A, mu.toggle_variance(), rho));
+
+       // contraction with delta tensor yields a metric tensor
+       result += check_equal_simplify(delta_tensor(mu, nu.toggle_variance()) * metric_tensor(nu, rho), metric_tensor(mu, rho));
+       result += check_equal_simplify(metric_tensor(mu, nu) * indexed(A, nu.toggle_variance()) * delta_tensor(mu.toggle_variance(), rho), indexed(A, rho));
+
+       return result;
+}
+
+static unsigned epsilon_check()
+{
+       // checks identities of the epsilon tensor
+
+       unsigned result = 0;
+
+       symbol s_mu("mu"), s_nu("nu"), s_rho("rho"), s_sigma("sigma"), s_tau("tau");
+       symbol d("d");
+       varidx mu(s_mu, 4), nu(s_nu, 4), rho(s_rho, 4), sigma(s_sigma, 4), tau(s_tau, 4);
+       varidx mu_co(s_mu, 4, true), nu_co(s_nu, 4, true), rho_co(s_rho, 4, true), sigma_co(s_sigma, 4, true), tau_co(s_tau, 4, true);
+
+       // antisymmetry
+       result += check_equal(lorentz_eps(mu, nu, rho, sigma) + lorentz_eps(sigma, rho, mu, nu), 0);
+
+       // convolution is zero
+       result += check_equal(lorentz_eps(mu, nu, rho, nu_co), 0);
+       result += check_equal(lorentz_eps(mu, nu, mu_co, nu_co), 0);
+       result += check_equal_simplify(lorentz_g(mu_co, nu_co) * lorentz_eps(mu, nu, rho, sigma), 0);
+
+       // contraction with symmetric tensor is zero
+       result += check_equal_simplify(lorentz_eps(mu, nu, rho, sigma) * indexed(d, sy_symm(), mu_co, nu_co), 0);
+       result += check_equal_simplify(lorentz_eps(mu, nu, rho, sigma) * indexed(d, sy_symm(), nu_co, sigma_co, rho_co), 0);
+       result += check_equal_simplify(lorentz_eps(mu, nu, rho, sigma) * indexed(d, mu_co) * indexed(d, nu_co), 0);
+       result += check_equal_simplify(lorentz_eps(mu_co, nu, rho, sigma) * indexed(d, mu) * indexed(d, nu_co), 0);
+       ex e = lorentz_eps(mu, nu, rho, sigma) * indexed(d, mu_co) - lorentz_eps(mu_co, nu, rho, sigma) * indexed(d, mu);
+       result += check_equal_simplify(e, 0);
+
+       // contractions of epsilon tensors
+       result += check_equal_simplify(lorentz_eps(mu, nu, rho, sigma) * lorentz_eps(mu_co, nu_co, rho_co, sigma_co), -24);
+       result += check_equal_simplify(lorentz_eps(tau, nu, rho, sigma) * lorentz_eps(mu_co, nu_co, rho_co, sigma_co), -6 * delta_tensor(tau, mu_co));
+
+       return result;
+}
+
+class symm_fcn : public function
+{
+       GINAC_DECLARE_FUNCTION_2P(symm_fcn)
+public:
+       virtual ex eval(int level = 0) const
+       {
+               // Canonicalize argument order according to the symmetry properties
+               exvector v = seq;
+               int sig = canonicalize(v.begin(), sy_symm(0, 1));
+               if (sig != INT_MAX) {
+                       // Something has changed while sorting arguments, more evaluations later
+                       if (sig == 0)
+                               return 0;
+                       return ex(sig) * thiscontainer(v);
+               }
+               return this->hold();
+       }
+};
+GINAC_IMPLEMENT_FUNCTION(symm_fcn)
+
+class anti_fcn : public function
+{
+       GINAC_DECLARE_FUNCTION_2P(anti_fcn)
+public:
+       virtual ex eval(int level = 0) const
+       {
+               // Canonicalize argument order according to the symmetry properties
+               exvector v = seq;
+               int sig = canonicalize(v.begin(), sy_anti(0, 1));
+               if (sig != INT_MAX) {
+                       // Something has changed while sorting arguments, more evaluations later
+                       if (sig == 0)
+                               return 0;
+                       return ex(sig) * thiscontainer(v);
+               }
+               return this->hold();
+       }
+};
+GINAC_IMPLEMENT_FUNCTION(anti_fcn)
+
+static unsigned symmetry_check()
+{
+       // check symmetric/antisymmetric objects
+
+       unsigned result = 0;
+
+       idx i(symbol("i"), 3), j(symbol("j"), 3), k(symbol("k"), 3), l(symbol("l"), 3);
+       symbol A("A"), B("B"), C("C");
+       ex e;
+
+       result += check_equal(indexed(A, sy_symm(), i, j), indexed(A, sy_symm(), j, i));
+       result += check_equal(indexed(A, sy_anti(), i, j) + indexed(A, sy_anti(), j, i), 0);
+       result += check_equal(indexed(A, sy_anti(), i, j, k) - indexed(A, sy_anti(), j, k, i), 0);
+       e = indexed(A, sy_symm(), i, j, k) *
+           indexed(B, sy_anti(), l, k, i);
+       result += check_equal_simplify(e, 0);
+       e = indexed(A, sy_symm(), i, i, j, j) *
+           indexed(B, sy_anti(), k, l); // GiNaC 0.8.0 had a bug here
+       result += check_equal_simplify(e, e);
+
+       symmetry R = sy_symm(sy_anti(0, 1), sy_anti(2, 3));
+       e = indexed(A, R, i, j, k, l) + indexed(A, R, j, i, k, l);
+       result += check_equal(e, 0);
+       e = indexed(A, R, i, j, k, l) + indexed(A, R, i, j, l, k);
+       result += check_equal(e, 0);
+       e = indexed(A, R, i, j, k, l) - indexed(A, R, j, i, l, k);
+       result += check_equal(e, 0);
+       e = indexed(A, R, i, j, k, l) + indexed(A, R, k, l, j, i);
+       result += check_equal(e, 0);
+
+       e = indexed(A, i, j);
+       result += check_equal(symmetrize(e) + antisymmetrize(e), e);
+       e = indexed(A, sy_symm(), i, j, k, l);
+       result += check_equal(symmetrize(e), e);
+       result += check_equal(antisymmetrize(e), 0);
+       e = indexed(A, sy_anti(), i, j, k, l);
+       result += check_equal(symmetrize(e), 0);
+       result += check_equal(antisymmetrize(e), e);
+
+       e = (indexed(A, sy_anti(), i, j, k, l) * (indexed(B, j) * indexed(C, k) + indexed(B, k) * indexed(C, j)) + indexed(B, i, l)).expand();
+       result += check_equal_simplify(e, indexed(B, i, l));
+
+       result += check_equal(symm_fcn(0, 1) + symm_fcn(1, 0), 2*symm_fcn(0, 1));
+       result += check_equal(anti_fcn(0, 1) + anti_fcn(1, 0), 0);
+       result += check_equal(anti_fcn(0, 0), 0);
+
+       return result;
+}
+
+static unsigned scalar_product_check()
+{
+       // check scalar product replacement
+
+       unsigned result = 0;
+
+    idx i(symbol("i"), 3), j(symbol("j"), 3);
+    symbol A("A"), B("B"), C("C");
+       ex e;
+
+    scalar_products sp;
+    sp.add(A, B, 0); // A and B are orthogonal
+    sp.add(A, C, 0); // A and C are orthogonal
+    sp.add(A, A, 4); // A^2 = 4 (A has length 2)
+
+    e = (indexed(A + B, i) * indexed(A + C, i)).expand(expand_options::expand_indexed);
+       result += check_equal_simplify(e, indexed(B, i) * indexed(C, i) + 4, sp);
+       e = indexed(A, i, i) * indexed(B, j, j); // GiNaC 0.8.0 had a bug here
+       result += check_equal_simplify(e, e, sp);
+
+       return result;
+}
+
+static unsigned edyn_check()
+{
+       // Relativistic electrodynamics
+
+       // Test 1: check transformation laws of electric and magnetic fields by
+       // applying a Lorentz boost to the field tensor
+
+       unsigned result = 0;
+
+       symbol beta("beta");
+       ex gamma = 1 / sqrt(1 - pow(beta, 2));
+       symbol Ex("Ex"), Ey("Ey"), Ez("Ez");
+       symbol Bx("Bx"), By("By"), Bz("Bz");
+
+       // Lorentz transformation matrix (boost along x axis)
+       matrix L(4, 4);
+       L =       gamma, -beta*gamma, 0, 0,
+           -beta*gamma,       gamma, 0, 0,
+                     0,           0, 1, 0,
+                     0,           0, 0, 1;
+
+       // Electromagnetic field tensor
+       matrix F(4, 4);
+       F =  0, -Ex, -Ey, -Ez,
+               Ex,   0, -Bz,  By,
+               Ey,  Bz,   0, -Bx,
+               Ez, -By,  Bx,   0;
+
+       // Indices
+       symbol s_mu("mu"), s_nu("nu"), s_rho("rho"), s_sigma("sigma");
+       varidx mu(s_mu, 4), nu(s_nu, 4), rho(s_rho, 4), sigma(s_sigma, 4);
+
+       // Apply transformation law of second rank tensor
+       ex e = (indexed(L, mu, rho.toggle_variance())
+             * indexed(L, nu, sigma.toggle_variance())
+             * indexed(F, rho, sigma)).simplify_indexed();
+
+       // Extract transformed electric and magnetic fields
+       ex Ex_p = e.subs(lst(mu == 1, nu == 0)).normal();
+       ex Ey_p = e.subs(lst(mu == 2, nu == 0)).normal();
+       ex Ez_p = e.subs(lst(mu == 3, nu == 0)).normal();
+       ex Bx_p = e.subs(lst(mu == 3, nu == 2)).normal();
+       ex By_p = e.subs(lst(mu == 1, nu == 3)).normal();
+       ex Bz_p = e.subs(lst(mu == 2, nu == 1)).normal();
+
+       // Check results
+       result += check_equal(Ex_p, Ex);
+       result += check_equal(Ey_p, gamma * (Ey - beta * Bz));
+       result += check_equal(Ez_p, gamma * (Ez + beta * By));
+       result += check_equal(Bx_p, Bx);
+       result += check_equal(By_p, gamma * (By + beta * Ez));
+       result += check_equal(Bz_p, gamma * (Bz - beta * Ey));
+
+       // Test 2: check energy density and Poynting vector of electromagnetic field
+
+       // Minkowski metric
+       ex eta = diag_matrix(lst(1, -1, -1, -1));
+
+       // Covariant field tensor
+       ex F_mu_nu = (indexed(eta, mu.toggle_variance(), rho.toggle_variance())
+                   * indexed(eta, nu.toggle_variance(), sigma.toggle_variance())
+                   * indexed(F, rho, sigma)).simplify_indexed();
+
+       // Energy-momentum tensor
+       ex T = (-indexed(eta, rho, sigma) * F_mu_nu.subs(s_nu == s_rho) 
+               * F_mu_nu.subs(lst(s_mu == s_nu, s_nu == s_sigma))
+             + indexed(eta, mu.toggle_variance(), nu.toggle_variance())
+               * F_mu_nu.subs(lst(s_mu == s_rho, s_nu == s_sigma))
+               * indexed(F, rho, sigma) / 4).simplify_indexed() / (4 * Pi);
+
+       // Extract energy density and Poynting vector
+       ex E = T.subs(lst(s_mu == 0, s_nu == 0)).normal();
+       ex Px = T.subs(lst(s_mu == 0, s_nu == 1));
+       ex Py = T.subs(lst(s_mu == 0, s_nu == 2)); 
+       ex Pz = T.subs(lst(s_mu == 0, s_nu == 3));
+
+       // Check results
+       result += check_equal(E, (Ex*Ex+Ey*Ey+Ez*Ez+Bx*Bx+By*By+Bz*Bz) / (8 * Pi));
+       result += check_equal(Px, (Ez*By-Ey*Bz) / (4 * Pi));
+       result += check_equal(Py, (Ex*Bz-Ez*Bx) / (4 * Pi));
+       result += check_equal(Pz, (Ey*Bx-Ex*By) / (4 * Pi));
+
+       return result;
+}
+
+static unsigned spinor_check()
+{
+       // check identities of the spinor metric
+
+       unsigned result = 0;
+
+       symbol psi("psi");
+       spinidx A(symbol("A")), B(symbol("B")), C(symbol("C")), D(symbol("D"));
+       ex A_co = A.toggle_variance(), B_co = B.toggle_variance();
+       ex e;
+
+       e = spinor_metric(A_co, B_co) * spinor_metric(A, B);
+       result += check_equal_simplify(e, 2);
+       e = spinor_metric(A_co, B_co) * spinor_metric(B, A);
+       result += check_equal_simplify(e, -2);
+       e = spinor_metric(A_co, B_co) * spinor_metric(A, C);
+       result += check_equal_simplify(e, delta_tensor(B_co, C));
+       e = spinor_metric(A_co, B_co) * spinor_metric(B, C);
+       result += check_equal_simplify(e, -delta_tensor(A_co, C));
+       e = spinor_metric(A_co, B_co) * spinor_metric(C, A);
+       result += check_equal_simplify(e, -delta_tensor(B_co, C));
+       e = spinor_metric(A, B) * indexed(psi, B_co);
+       result += check_equal_simplify(e, indexed(psi, A));
+       e = spinor_metric(A, B) * indexed(psi, A_co);
+       result += check_equal_simplify(e, -indexed(psi, B));
+       e = spinor_metric(A_co, B_co) * indexed(psi, B);
+       result += check_equal_simplify(e, -indexed(psi, A_co));
+       e = spinor_metric(A_co, B_co) * indexed(psi, A);
+       result += check_equal_simplify(e, indexed(psi, B_co));
+       e = spinor_metric(D, A) * spinor_metric(A_co, B_co) * spinor_metric(B, C) - spinor_metric(D, A_co) * spinor_metric(A, B_co) * spinor_metric(B, C);
+       result += check_equal_simplify(e, 0);
+
+       return result;
+}
+
+static unsigned dummy_check()
+{
+       // check dummy index renaming/repositioning
+
+       unsigned result = 0;
+
+       symbol p("p"), q("q");
+       idx i(symbol("i"), 3), j(symbol("j"), 3), n(symbol("n"), 3);
+       varidx mu(symbol("mu"), 4), nu(symbol("nu"), 4);
+       ex e;
+
+       e = indexed(p, i) * indexed(q, i) - indexed(p, j) * indexed(q, j);
+       result += check_equal_simplify(e, 0);
+
+       e = indexed(p, i) * indexed(p, i) * indexed(q, j) * indexed(q, j)
+         - indexed(p, n) * indexed(p, n) * indexed(q, j) * indexed(q, j);
+       result += check_equal_simplify(e, 0);
+
+       e = indexed(p, mu, mu.toggle_variance()) - indexed(p, nu, nu.toggle_variance());
+       result += check_equal_simplify(e, 0);
+
+       e = indexed(p, mu.toggle_variance(), nu, mu) * indexed(q, i)
+         - indexed(p, mu, nu, mu.toggle_variance()) * indexed(q, i);
+       result += check_equal_simplify(e, 0);
+
+       e = indexed(p, mu, mu.toggle_variance()) - indexed(p, nu.toggle_variance(), nu);
+       result += check_equal_simplify(e, 0);
+       e = indexed(p, mu.toggle_variance(), mu) - indexed(p, nu, nu.toggle_variance());
+       result += check_equal_simplify(e, 0);
+
+       // GiNaC 1.2.1 had a bug here because p.i*p.i -> (p.i)^2
+       e = indexed(p, i) * indexed(p, i) * indexed(p, j) + indexed(p, j);
+       ex fi = exprseq(e.get_free_indices());
+       if (!fi.is_equal(exprseq(j))) {
+               clog << "get_free_indices(" << e << ") erroneously returned "
+                    << fi << " instead of (.j)" << endl;
+               ++result;
+       }
+
+       return result;
+}
+
+unsigned exam_indexed()
+{
+       unsigned result = 0;
+       
+       cout << "examining indexed objects" << flush;
+       clog << "----------indexed objects:" << endl;
+
+       result += delta_check();  cout << '.' << flush;
+       result += metric_check();  cout << '.' << flush;
+       result += epsilon_check();  cout << '.' << flush;
+       result += symmetry_check();  cout << '.' << flush;
+       result += scalar_product_check();  cout << '.' << flush;
+       result += edyn_check();  cout << '.' << flush;
+       result += spinor_check(); cout << '.' << flush;
+       result += dummy_check(); cout << '.' << flush;
+       
+       if (!result) {
+               cout << " passed " << endl;
+               clog << "(no output)" << endl;
+       } else {
+               cout << " failed " << endl;
+       }
+       
+       return result;
+}
diff --git a/check/exam_pseries.cpp b/check/exam_pseries.cpp
new file mode 100644 (file)
index 0000000..4021c4f
--- /dev/null
@@ -0,0 +1,379 @@
+/** @File exam_pseries.cpp
+ *
+ *  Series expansion test (Laurent and Taylor series). */
+
+/*
+ *  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 "exams.h"
+
+static symbol x("x");
+
+static unsigned check_series(const ex &e, const ex &point, const ex &d, int order = 8)
+{
+       ex es = e.series(x==point, order);
+       ex ep = ex_to<pseries>(es).convert_to_poly();
+       if (!(ep - d).expand().is_zero()) {
+               clog << "series expansion of " << e << " at " << point
+                    << " erroneously returned " << ep << " (instead of " << d
+                    << ")" << endl;
+               clog << tree << (ep-d) << dflt;
+               return 1;
+       }
+       return 0;
+}
+
+// Series expansion
+static unsigned exam_series1()
+{
+       using GiNaC::log;
+
+       symbol a("a");
+       symbol b("b");
+       unsigned result = 0;
+       ex e, d;
+       
+       e = pow(a+b, x);
+       d = 1 + Order(pow(x, 1));
+       result += check_series(e, 0, d, 1);
+
+       e = sin(x);
+       d = x - pow(x, 3) / 6 + pow(x, 5) / 120 - pow(x, 7) / 5040 + Order(pow(x, 8));
+       result += check_series(e, 0, d);
+       
+       e = cos(x);
+       d = 1 - pow(x, 2) / 2 + pow(x, 4) / 24 - pow(x, 6) / 720 + Order(pow(x, 8));
+       result += check_series(e, 0, d);
+       
+       e = exp(x);
+       d = 1 + x + pow(x, 2) / 2 + pow(x, 3) / 6 + pow(x, 4) / 24 + pow(x, 5) / 120 + pow(x, 6) / 720 + pow(x, 7) / 5040 + Order(pow(x, 8));
+       result += check_series(e, 0, d);
+       
+       e = pow(1 - x, -1);
+       d = 1 + x + pow(x, 2) + pow(x, 3) + pow(x, 4) + pow(x, 5) + pow(x, 6) + pow(x, 7) + Order(pow(x, 8));
+       result += check_series(e, 0, d);
+       
+       e = x + pow(x, -1);
+       d = x + pow(x, -1);
+       result += check_series(e, 0, d);
+       
+       e = x + pow(x, -1);
+       d = 2 + pow(x-1, 2) - pow(x-1, 3) + pow(x-1, 4) - pow(x-1, 5) + pow(x-1, 6) - pow(x-1, 7) + Order(pow(x-1, 8));
+       result += check_series(e, 1, d);
+       
+       e = pow(x + pow(x, 3), -1);
+       d = pow(x, -1) - x + pow(x, 3) - pow(x, 5) + pow(x, 7) + Order(pow(x, 8));
+       result += check_series(e, 0, d);
+       
+       e = pow(pow(x, 2) + pow(x, 4), -1);
+       d = pow(x, -2) - 1 + pow(x, 2) - pow(x, 4) + pow(x, 6) + Order(pow(x, 8));
+       result += check_series(e, 0, d);
+       
+       e = pow(sin(x), -2);
+       d = pow(x, -2) + numeric(1,3) + pow(x, 2) / 15 + pow(x, 4) * 2/189 + pow(x, 6) / 675  + Order(pow(x, 8));
+       result += check_series(e, 0, d);
+       
+       e = sin(x) / cos(x);
+       d = x + pow(x, 3) / 3 + pow(x, 5) * 2/15 + pow(x, 7) * 17/315 + Order(pow(x, 8));
+       result += check_series(e, 0, d);
+       
+       e = cos(x) / sin(x);
+       d = pow(x, -1) - x / 3 - pow(x, 3) / 45 - pow(x, 5) * 2/945 - pow(x, 7) / 4725 + Order(pow(x, 8));
+       result += check_series(e, 0, d);
+       
+       e = pow(numeric(2), x);
+       ex t = log(2) * x;
+       d = 1 + t + pow(t, 2) / 2 + pow(t, 3) / 6 + pow(t, 4) / 24 + pow(t, 5) / 120 + pow(t, 6) / 720 + pow(t, 7) / 5040 + Order(pow(x, 8));
+       result += check_series(e, 0, d.expand());
+       
+       e = pow(Pi, x);
+       t = log(Pi) * x;
+       d = 1 + t + pow(t, 2) / 2 + pow(t, 3) / 6 + pow(t, 4) / 24 + pow(t, 5) / 120 + pow(t, 6) / 720 + pow(t, 7) / 5040 + Order(pow(x, 8));
+       result += check_series(e, 0, d.expand());
+       
+       e = log(x);
+       d = e;
+       result += check_series(e, 0, d, 1);
+       result += check_series(e, 0, d, 2);
+       
+       e = pow(x, 8) * pow(pow(x,3)+ pow(x + pow(x,3), 2), -2);
+       d = pow(x, 4) - 2*pow(x, 5) + Order(pow(x, 6));
+       result += check_series(e, 0, d, 6);
+       
+       e = cos(x) * pow(sin(x)*(pow(x, 5) + 4 * pow(x, 2)), -3);
+       d = pow(x, -9) / 64 - 3 * pow(x, -6) / 256 - pow(x, -5) / 960 + 535 * pow(x, -3) / 96768
+           + pow(x, -2) / 1280 - pow(x, -1) / 14400 - numeric(283, 129024) - 2143 * x / 5322240
+           + Order(pow(x, 2));
+       result += check_series(e, 0, d, 2);
+       
+       e = sqrt(1+x*x) * sqrt(1+2*x*x);
+       d = 1 + Order(pow(x, 2));
+       result += check_series(e, 0, d, 2);
+
+       e = pow(x, 4) * sin(a) + pow(x, 2);
+       d = pow(x, 2) + Order(pow(x, 3));
+       result += check_series(e, 0, d, 3);
+
+       e = log(a*x + b*x*x*log(x));
+       d = log(a*x) + b/a*log(x)*x - pow(b/a, 2)/2*pow(log(x)*x, 2) + Order(pow(x, 3));
+       result += check_series(e, 0, d, 3);
+
+       e = pow((x+a), b);
+       d = pow(a, b) + (pow(a, b)*b/a)*x + (pow(a, b)*b*b/a/a/2 - pow(a, b)*b/a/a/2)*pow(x, 2) + Order(pow(x, 3));
+       result += check_series(e, 0, d, 3);
+
+       return result;
+}
+
+// Series addition
+static unsigned exam_series2()
+{
+       unsigned result = 0;
+       ex e, d;
+       
+       e = pow(sin(x), -1).series(x==0, 8) + pow(sin(-x), -1).series(x==0, 12);
+       d = Order(pow(x, 8));
+       result += check_series(e, 0, d);
+       
+       return result;
+}
+
+// Series multiplication
+static unsigned exam_series3()
+{
+       unsigned result = 0;
+       ex e, d;
+       
+       e = sin(x).series(x==0, 8) * pow(sin(x), -1).series(x==0, 12);
+       d = 1 + Order(pow(x, 7));
+       result += check_series(e, 0, d);
+       
+       return result;
+}
+
+// Series exponentiation
+static unsigned exam_series4()
+{
+       unsigned result = 0;
+       ex e, d;
+       
+       e = pow((2*cos(x)).series(x==0, 5), 2).series(x==0, 5);
+       d = 4 - 4*pow(x, 2) + 4*pow(x, 4)/3 + Order(pow(x, 5));
+       result += check_series(e, 0, d);
+       
+       e = pow(tgamma(x), 2).series(x==0, 2);
+       d = pow(x,-2) - 2*Euler/x + (pow(Pi,2)/6+2*pow(Euler,2)) 
+               + x*(-4*pow(Euler, 3)/3 -pow(Pi,2)*Euler/3 - 2*zeta(3)/3) + Order(pow(x, 2));
+       result += check_series(e, 0, d);
+       
+       return result;
+}
+
+// Order term handling
+static unsigned exam_series5()
+{
+       unsigned result = 0;
+       ex e, d;
+
+       e = 1 + x + pow(x, 2) + pow(x, 3);
+       d = Order(1);
+       result += check_series(e, 0, d, 0);
+       d = 1 + Order(x);
+       result += check_series(e, 0, d, 1);
+       d = 1 + x + Order(pow(x, 2));
+       result += check_series(e, 0, d, 2);
+       d = 1 + x + pow(x, 2) + Order(pow(x, 3));
+       result += check_series(e, 0, d, 3);
+       d = 1 + x + pow(x, 2) + pow(x, 3);
+       result += check_series(e, 0, d, 4);
+       return result;
+}
+
+// Series expansion of tgamma(-1)
+static unsigned exam_series6()
+{
+       ex e = tgamma(2*x);
+       ex d = pow(x+1,-1)*numeric(1,4) +
+              pow(x+1,0)*(numeric(3,4) -
+                          numeric(1,2)*Euler) +
+              pow(x+1,1)*(numeric(7,4) -
+                          numeric(3,2)*Euler +
+                          numeric(1,2)*pow(Euler,2) +
+                          numeric(1,12)*pow(Pi,2)) +
+              pow(x+1,2)*(numeric(15,4) -
+                          numeric(7,2)*Euler -
+                          numeric(1,3)*pow(Euler,3) +
+                          numeric(1,4)*pow(Pi,2) +
+                          numeric(3,2)*pow(Euler,2) -
+                          numeric(1,6)*pow(Pi,2)*Euler -
+                          numeric(2,3)*zeta(3)) +
+              pow(x+1,3)*(numeric(31,4) - pow(Euler,3) -
+                          numeric(15,2)*Euler +
+                          numeric(1,6)*pow(Euler,4) +
+                          numeric(7,2)*pow(Euler,2) +
+                          numeric(7,12)*pow(Pi,2) -
+                          numeric(1,2)*pow(Pi,2)*Euler -
+                          numeric(2)*zeta(3) +
+                          numeric(1,6)*pow(Euler,2)*pow(Pi,2) +
+                          numeric(1,40)*pow(Pi,4) +
+                          numeric(4,3)*zeta(3)*Euler) +
+              Order(pow(x+1,4));
+       return check_series(e, -1, d, 4);
+}
+       
+// Series expansion of tan(x==Pi/2)
+static unsigned exam_series7()
+{
+       ex e = tan(x*Pi/2);
+       ex d = pow(x-1,-1)/Pi*(-2) + pow(x-1,1)*Pi/6 + pow(x-1,3)*pow(Pi,3)/360
+             +pow(x-1,5)*pow(Pi,5)/15120 + pow(x-1,7)*pow(Pi,7)/604800
+             +Order(pow(x-1,9));
+       return check_series(e,1,d,9);
+}
+
+// Series expansion of log(sin(x==0))
+static unsigned exam_series8()
+{
+       ex e = log(sin(x));
+       ex d = log(x) - pow(x,2)/6 - pow(x,4)/180 - pow(x,6)/2835 - pow(x,8)/37800 + Order(pow(x,9));
+       return check_series(e,0,d,9);
+}
+
+// Series expansion of Li2(sin(x==0))
+static unsigned exam_series9()
+{
+       ex e = Li2(sin(x));
+       ex d = x + pow(x,2)/4 - pow(x,3)/18 - pow(x,4)/48
+              - 13*pow(x,5)/1800 - pow(x,6)/360 - 23*pow(x,7)/21168
+              + Order(pow(x,8));
+       return check_series(e,0,d,8);
+}
+
+// Series expansion of Li2((x==2)^2), caring about branch-cut
+static unsigned exam_series10()
+{
+       using GiNaC::log;
+
+       ex e = Li(2, pow(x,2));
+       ex d = Li(2, 4) + (-log(3) + I*Pi*csgn(I-I*pow(x,2))) * (x-2)
+              + (numeric(-2,3) + log(3)/4 - I*Pi/4*csgn(I-I*pow(x,2))) * pow(x-2,2)
+              + (numeric(11,27) - log(3)/12 + I*Pi/12*csgn(I-I*pow(x,2))) * pow(x-2,3)
+              + (numeric(-155,648) + log(3)/32 - I*Pi/32*csgn(I-I*pow(x,2))) * pow(x-2,4)
+              + Order(pow(x-2,5));
+       return check_series(e,2,d,5);
+}
+
+// Series expansion of logarithms around branch points
+static unsigned exam_series11()
+{
+       using GiNaC::log;
+
+       unsigned result = 0;
+       ex e, d;
+       symbol a("a");
+       
+       e = log(x);
+       d = log(x);
+       result += check_series(e,0,d,5);
+       
+       e = log(3/x);
+       d = log(3)-log(x);
+       result += check_series(e,0,d,5);
+       
+       e = log(3*pow(x,2));
+       d = log(3)+2*log(x);
+       result += check_series(e,0,d,5);
+       
+       // These ones must not be expanded because it would result in a branch cut
+       // running in the wrong direction. (Other systems tend to get this wrong.)
+       e = log(-x);
+       d = e;
+       result += check_series(e,0,d,5);
+       
+       e = log(I*(x-123));
+       d = e;
+       result += check_series(e,123,d,5);
+       
+       e = log(a*x);
+       d = e;  // we don't know anything about a!
+       result += check_series(e,0,d,5);
+       
+       e = log((1-x)/x);
+       d = log(1-x) - (x-1) + pow(x-1,2)/2 - pow(x-1,3)/3  + pow(x-1,4)/4 + Order(pow(x-1,5));
+       result += check_series(e,1,d,5);
+       
+       return result;
+}
+
+// Series expansion of other functions around branch points
+static unsigned exam_series12()
+{
+       using GiNaC::log;
+
+       unsigned result = 0;
+       ex e, d;
+       
+       // NB: Mma and Maple give different results, but they agree if one
+       // takes into account that by assumption |x|<1.
+       e = atan(x);
+       d = (I*log(2)/2-I*log(1+I*x)/2) + (x-I)/4 + I*pow(x-I,2)/16 + Order(pow(x-I,3));
+       result += check_series(e,I,d,3);
+       
+       // NB: here, at -I, Mathematica disagrees, but it is wrong -- they
+       // pick up a complex phase by incorrectly expanding logarithms.
+       e = atan(x);
+       d = (-I*log(2)/2+I*log(1-I*x)/2) + (x+I)/4 - I*pow(x+I,2)/16 + Order(pow(x+I,3));
+       result += check_series(e,-I,d,3);
+       
+       // This is basically the same as above, the branch point is at +/-1:
+       e = atanh(x);
+       d = (-log(2)/2+log(x+1)/2) + (x+1)/4 + pow(x+1,2)/16 + Order(pow(x+1,3));
+       result += check_series(e,-1,d,3);
+       
+       return result;
+}
+
+
+unsigned exam_pseries()
+{
+       unsigned result = 0;
+       
+       cout << "examining series expansion" << flush;
+       clog << "----------series expansion:" << endl;
+       
+       result += exam_series1();  cout << '.' << flush;
+       result += exam_series2();  cout << '.' << flush;
+       result += exam_series3();  cout << '.' << flush;
+       result += exam_series4();  cout << '.' << flush;
+       result += exam_series5();  cout << '.' << flush;
+       result += exam_series6();  cout << '.' << flush;
+       result += exam_series7();  cout << '.' << flush;
+       result += exam_series8();  cout << '.' << flush;
+       result += exam_series9();  cout << '.' << flush;
+       result += exam_series10();  cout << '.' << flush;
+       result += exam_series11();  cout << '.' << flush;
+       result += exam_series12();  cout << '.' << flush;
+       
+       if (!result) {
+               cout << " passed " << endl;
+               clog << "(no output)" << endl;
+       } else {
+               cout << " failed " << endl;
+       }
+       return result;
+}
index 0907823a0a0e6da1d8a5d234d946024a16552cf6..df3e847751bdc19ed441a9ea5edaa4b2629c4428 100644 (file)
@@ -1,33 +1,24 @@
 ## Process this file with automake to produce Makefile.in
 
 lib_LTLIBRARIES = libginac.la
-libginac_la_SOURCES = add.cpp basic.cpp constant.cpp diff.cpp ex.cpp \
-  expairseq.cpp exprseq.cpp fail.cpp function.cpp inifcns.cpp \
-  inifcns_trans.cpp inifcns_zeta.cpp inifcns_gamma.cpp matrix.cpp mul.cpp \
-  normal.cpp numeric.cpp operators.cpp power.cpp print.cpp printraw.cpp \
-  printtree.cpp printcsrc.cpp relational.cpp symbol.cpp utils.cpp series.cpp \
-  ncmul.cpp clifford.cpp structure.cpp color.cpp indexed.cpp idx.cpp \
-  isospin.cpp exprseq_suppl.cpp lst.cpp lst_suppl.cpp simp_lor.cpp \
-  coloridx.cpp lorentzidx.cpp debugmsg.h utils.h
-libginac_la_LDFLAGS = -version-info $(LT_CURRENT):$(LT_REVISION):$(LT_AGE) \
-  -release $(LT_RELEASE)
+libginac_la_SOURCES = add.cpp archive.cpp basic.cpp clifford.cpp color.cpp \
+  constant.cpp ex.cpp excompiler.cpp expair.cpp expairseq.cpp exprseq.cpp \
+  fail.cpp function.cpp idx.cpp indexed.cpp inifcns.cpp inifcns_exp.cpp \
+  inifcns_polylog.cpp inifcns_trig.cpp \
+  integral.cpp lst.cpp matrix.cpp mul.cpp ncmul.cpp normal.cpp numeric.cpp \
+  operators.cpp power.cpp registrar.cpp relational.cpp \
+  pseries.cpp print.cpp symbol.cpp symmetry.cpp tensor.cpp \
+  utils.cpp wildcard.cpp input_parser.yy input_lexer.ll \
+  input_lexer.h tostring.h utils.h
+libginac_la_LDFLAGS = -version-info $(LT_VERSION_INFO) -release $(LT_RELEASE)
 ginacincludedir = $(includedir)/ginac
-ginacinclude_HEADERS = ginac.h add.h basic.h clifford.h color.h coloridx.h \
-  constant.h ex.h expair.h expairseq.h exprseq.h fail.h flags.h function.h \
-  idx.h indexed.h inifcns.h isospin.h lorentzidx.h lst.h matrix.h mul.h \
-  ncmul.h normal.h numeric.h operators.h power.h relational.h series.h \
-  simp_lor.h structure.h symbol.h tinfos.h assertion.h
-EXTRA_DIST = container.pl function.pl structure.pl
-
-# Files which are generated by perl scripts
-function.h function.cpp: function.pl
-       perl function.pl
-
-lst.h lst.cpp: container.pl
-       perl container.pl lst
-
-exprseq.h exprseq.cpp: container.pl
-       perl container.pl exprseq
-
-# Force build of headers before compilation
-add.cpp: function.h lst.h exprseq.h
+ginacinclude_HEADERS = ginac.h add.h archive.h assertion.h basic.h class_info.h \
+  clifford.h color.h constant.h container.h ex.h excompiler.h expair.h expairseq.h \
+  exprseq.h fail.h flags.h function.h hash_map.h idx.h indexed.h inifcns.h \
+  inifcns_exp.h inifcns_polylog.h inifcns_trig.h \
+  integral.h lst.h matrix.h mul.h ncmul.h normal.h numeric.h operators.h \
+  power.h print.h pseries.h ptr.h registrar.h relational.h structure.h \
+  symbol.h symmetry.h tensor.h version.h wildcard.h
+AM_LFLAGS = -Pginac_yy -olex.yy.c
+AM_YFLAGS = -p ginac_yy -d
+EXTRA_DIST = input_parser.h version.h.in
index 90f4e38d992960961613eba7d8d52f3ffd063552..e26515305fc185872c5642c4f14ae80ef258b588 100644 (file)
@@ -3,7 +3,7 @@
  *  Collection of all flags used through the GiNaC framework. */
 
 /*
- *  GiNaC Copyright (C) 1999 Johannes Gutenberg University Mainz, Germany
+ *  GiNaC Copyright (C) 1999-2006 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
@@ -17,7 +17,7 @@
  *
  *  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  */
 
 #ifndef __GINAC_FLAGS_H__
 
 namespace GiNaC {
 
+/** Flags to control the behavior of expand(). */
 class expand_options {
 public:
-    enum { expand_trigonometric      = 0x0001
-         };
+       enum {
+               expand_indexed = 0x0001,      ///< expands (a+b).i to a.i+b.i
+               expand_function_args = 0x0002 ///< expands the arguments of functions
+       };
 };
 
-class status_flags {
+/** Flags to control the behavior of has(). */
+class has_options {
 public:
-    enum { dynallocated              = 0x0001,
-           evaluated                 = 0x0002,
-           expanded                  = 0x0004,
-           hash_calculated           = 0x0008
-         };
+       enum {
+               algebraic = 0x0001,              ///< enable algebraic matching
+       };
 };
 
-class info_flags {
+/** Flags to control the behavior of subs(). */
+class subs_options {
 public:
-    enum { 
-           // answered by class numeric
-           numeric,
-           real,
-           rational,
-           integer,
-           positive,
-           negative,
-           nonnegative,
-           posint,
-           negint,
-           nonnegint,
-           even,
-           odd,
-           prime,
-
-           // answered by class relation
-           relation,
-           relation_equal,
-           relation_not_equal,
-           relation_less,
-           relation_less_or_equal,
-           relation_greater,
-           relation_greater_or_equal,
-
-           // answered by class symbol
-           symbol,
-
-           // answered by class lst
-           list,
-
-           // answered by class exprseq
-           exprseq,
-
-           // answered by classes numeric, symbol, add, mul, power
-           polynomial,
-           integer_polynomial,
-           rational_polynomial,
-           rational_function,
-
-           // answered by class ex
-           normal_form,
-           
-           // answered by class indexed
-           indexed,      // class can carry indices
-           has_indices,  // object has at least one index
-
-           // answered by class idx
-           idx,
-
-           // answered by class coloridx
-           coloridx,
-
-           // answered by class lorentzidx
-           lorentzidx
-    };
+       enum {
+               no_pattern = 0x0001,             ///< disable pattern matching
+               subs_no_pattern = 0x0001, // for backwards compatibility
+               algebraic = 0x0002,              ///< enable algebraic substitutions
+               subs_algebraic = 0x0002,  // for backwards compatibility
+               pattern_is_product = 0x0004,     ///< used internally by expairseq::subschildren()
+               pattern_is_not_product = 0x0008, ///< used internally by expairseq::subschildren()
+               no_index_renaming = 0x0010
+       };
 };
 
-class return_types {
+/** Domain of an object */
+class domain {
+public:
+       enum {
+               complex,
+               real
+       };
+};
+
+/** Flags to control series expansion. */
+class series_options {
+public:
+       enum {
+               /** Suppress branch cuts in series expansion.  Branch cuts manifest
+                *  themselves as step functions, if this option is not passed.  If
+                *  it is passed and expansion at a point on a cut is performed, then
+                *  the analytic continuation of the function is expanded. */
+               suppress_branchcut = 0x0001
+       };
+};
+
+/** Switch to control algorithm for determinant computation. */
+class determinant_algo {
 public:
-    enum { commutative, noncommutative, noncommutative_composite};
+       enum {
+               /** Let the system choose.  A heuristics is applied for automatic
+                *  determination of a suitable algorithm. */
+               automatic,
+               /** Gauss elimination.  If \f$m_{i,j}^{(0)}\f$ are the entries of the
+                *  original matrix, then the matrix is transformed into triangular
+                *  form by applying the rules
+                *  \f[
+                *      m_{i,j}^{(k+1)} = m_{i,j}^{(k)} - m_{i,k}^{(k)} m_{k,j}^{(k)} / m_{k,k}^{(k)}
+                *  \f]
+                *  The determinant is then just the product of diagonal elements.
+                *  Choose this algorithm only for purely numerical matrices. */
+               gauss,
+               /** Division-free elimination.  This is a modification of Gauss
+                *  elimination where the division by the pivot element is not
+                *  carried out.  If \f$m_{i,j}^{(0)}\f$ are the entries of the
+                *  original matrix, then the matrix is transformed into triangular
+                *  form by applying the rules
+                *  \f[
+                *      m_{i,j}^{(k+1)} = m_{i,j}^{(k)} m_{k,k}^{(k)} - m_{i,k}^{(k)} m_{k,j}^{(k)}
+                *  \f]
+                *  The determinant can later be computed by inspecting the diagonal
+                *  elements only.  This algorithm is only there for the purpose of
+                *  cross-checks.  It is never fast. */
+               divfree,
+               /** Laplace elimination.  This is plain recursive elimination along
+                *  minors although multiple minors are avoided by the algorithm.
+                *  Although the algorithm is exponential in complexity it is
+                *  frequently the fastest one when the matrix is populated by
+                *  complicated symbolic expressions. */
+               laplace,
+               /** Bareiss fraction-free elimination.  This is a modification of
+                *  Gauss elimination where the division by the pivot element is
+                *  <EM>delayed</EM> until it can be carried out without computing
+                *  GCDs.  If \f$m_{i,j}^{(0)}\f$ are the entries of the original
+                *  matrix, then the matrix is transformed into triangular form by
+                *  applying the rules
+                *  \f[
+                *      m_{i,j}^{(k+1)} = (m_{i,j}^{(k)} m_{k,k}^{(k)} - m_{i,k}^{(k)} m_{k,j}^{(k)}) / m_{k-1,k-1}^{(k-1)}
+                *  \f]
+                *  (We have set \f$m_{-1,-1}^{(-1)}=1\f$ in order to avoid a case
+                *  distinction in above formula.)  It can be shown that nothing more
+                *  than polynomial long division is needed for carrying out the
+                *  division.  The determinant can then be read of from the lower
+                *  right entry.  This algorithm is rarely fast for computing
+                *  determinants. */
+               bareiss
+       };
 };
 
-class csrc_types {
+/** Switch to control algorithm for linear system solving. */
+class solve_algo {
+public:
+       enum {
+               /** Let the system choose.  A heuristics is applied for automatic
+                *  determination of a suitable algorithm. */
+               automatic,
+               /** Gauss elimination.  If \f$m_{i,j}^{(0)}\f$ are the entries of the
+                *  original matrix, then the matrix is transformed into triangular
+                *  form by applying the rules
+                *  \f[
+                *      m_{i,j}^{(k+1)} = m_{i,j}^{(k)} - m_{i,k}^{(k)} m_{k,j}^{(k)} / m_{k,k}^{(k)}
+                *  \f]
+                *  This algorithm is well-suited for numerical matrices but generally
+                *  suffers from the expensive division (and computation of GCDs) at
+                *  each step. */
+               gauss,
+               /** Division-free elimination.  This is a modification of Gauss
+                *  elimination where the division by the pivot element is not
+                *  carried out.  If \f$m_{i,j}^{(0)}\f$ are the entries of the
+                *  original matrix, then the matrix is transformed into triangular
+                *  form by applying the rules
+                *  \f[
+                *      m_{i,j}^{(k+1)} = m_{i,j}^{(k)} m_{k,k}^{(k)} - m_{i,k}^{(k)} m_{k,j}^{(k)}
+                *  \f]
+                *  This algorithm is only there for the purpose of cross-checks.
+                *  It suffers from exponential intermediate expression swell.  Use it
+                *  only for small systems. */
+               divfree,
+               /** Bareiss fraction-free elimination.  This is a modification of
+                *  Gauss elimination where the division by the pivot element is
+                *  <EM>delayed</EM> until it can be carried out without computing
+                *  GCDs.  If \f$m_{i,j}^{(0)}\f$ are the entries of the original
+                *  matrix, then the matrix is transformed into triangular form by
+                *  applying the rules
+                *  \f[
+                *      m_{i,j}^{(k+1)} = (m_{i,j}^{(k)} m_{k,k}^{(k)} - m_{i,k}^{(k)} m_{k,j}^{(k)}) / m_{k-1,k-1}^{(k-1)}
+                *  \f]
+                *  (We have set \f$m_{-1,-1}^{(-1)}=1\f$ in order to avoid a case
+                *  distinction in above formula.)  It can be shown that nothing more
+                *  than polynomial long division is needed for carrying out the
+                *  division.  This is generally the fastest algorithm for solving
+                *  linear systems.  In contrast to division-free elimination it only
+                *  has a linear expression swell.  For two-dimensional systems, the
+                *  two algorithms are equivalent, however. */
+               bareiss
+       };
+};
+
+/** Flags to store information about the state of an object.
+ *  @see basic::flags */
+class status_flags {
+public:
+       enum {
+               dynallocated    = 0x0001, ///< heap-allocated (i.e. created by new if we want to be clever and bypass the stack, @see ex::construct_from_basic() )
+               evaluated       = 0x0002, ///< .eval() has already done its job
+               expanded        = 0x0004, ///< .expand(0) has already done its job (other expand() options ignore this flag)
+               hash_calculated = 0x0008, ///< .calchash() has already done its job
+               not_shareable   = 0x0010  ///< don't share instances of this object between different expressions unless explicitly asked to (used by ex::compare())
+       };
+};
+
+/** Possible attributes an object can have. */
+class info_flags {
+public:
+       enum {
+               // answered by class numeric
+               numeric,
+               real,
+               rational,
+               integer,
+               crational,
+               cinteger,
+               positive,
+               negative,
+               nonnegative,
+               posint,
+               negint,
+               nonnegint,
+               even,
+               odd,
+               prime,
+
+               // answered by class relation
+               relation,
+               relation_equal,
+               relation_not_equal,
+               relation_less,
+               relation_less_or_equal,
+               relation_greater,
+               relation_greater_or_equal,
+
+               // answered by class symbol
+               symbol,
+
+               // answered by class lst
+               list,
+
+               // answered by class exprseq
+               exprseq,
+
+               // answered by class function
+               function,
+
+               // answered by classes numeric, symbol, add, mul, power
+               polynomial,
+               integer_polynomial,
+               cinteger_polynomial,
+               rational_polynomial,
+               crational_polynomial,
+               rational_function,
+               algebraic,
+
+               // answered by class indexed
+               indexed,      // class can carry indices
+               has_indices,  // object has at least one index
+
+               // answered by class idx
+               idx
+       };
+};
+
+class return_types {
 public:
        enum {
-               ctype_float,
-               ctype_double,
-               ctype_cl_N
+               commutative,
+               noncommutative,
+               noncommutative_composite
        };
 };
 
diff --git a/ginac/function.cpp b/ginac/function.cpp
new file mode 100644 (file)
index 0000000..6a322db
--- /dev/null
@@ -0,0 +1,196 @@
+/** @file function.cpp
+ *
+ *  Implementation of class of symbolic functions. */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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 <string>
+#include <vector>
+
+#include "function.h"
+
+#include "inifcns.h"
+#include "operators.h"
+#include "power.h"
+#include "utils.h"
+
+namespace GiNaC {
+
+GINAC_IMPLEMENT_REGISTERED_CLASS(function, exprseq)
+
+function::function(const archive_node& n, lst& sym_lst) : inherited(n, sym_lst)
+{
+}
+
+void function::archive(archive_node& n) const
+{ 
+    inherited::archive(n);
+}
+
+ex function::unarchive(const archive_node& n, lst& sym_lst)
+{
+    return (new function(n, sym_lst))->setflag(status_flags::dynallocated);
+}
+
+function* function::duplicate() const
+{
+       return new function(*this);
+}
+
+void function::accept(GiNaC::visitor& v) const
+{
+       if (visitor* p = dynamic_cast<visitor*>(&v)) {
+               p->visit(*this);
+       } else {
+               inherited::accept(v);
+       }
+}
+
+int function::compare_same_type(const basic& other) const 
+{
+       if (tinfo_key == other.tinfo()) {
+               return exprseq::compare_same_type(other); 
+       } else {
+               return compare_pointers(tinfo_key, other.tinfo());
+       }
+}
+
+bool function::is_equal_same_type(const basic& other) const 
+{
+       if (tinfo_key == other.tinfo()) {
+               return exprseq::is_equal_same_type(other);
+       } else {
+               return false;
+       }
+}
+
+bool function::match_same_type(const basic & other) const
+{
+       return tinfo_key == other.tinfo();
+}
+
+unsigned function::return_type() const
+{
+//     GINAC_ASSERT(serial<registered_functions().size());
+       // Default behavior is to use the return type of the first
+       // argument. Thus, exp() of a matrix behaves like a matrix, etc.
+       if (seq.empty()) {
+               return return_types::commutative;
+       } else {
+               return seq.begin()->return_type();
+       }
+}
+
+tinfo_t function::return_type_tinfo() const
+{
+       //GINAC_ASSERT(serial<registered_functions().size());
+       // Default behavior is to use the return type of the first
+       // argument. Thus, exp() of a matrix behaves like a matrix, etc.
+       if (seq.empty()) {
+               return this;
+       } else {
+               return seq.begin()->return_type_tinfo();
+       }
+}
+
+ex function::conjugate() const
+{
+       return conjugate_function(*this);
+}
+
+ex function::derivative(const symbol& s) const
+{
+       // Chain rule
+       ex arg_diff;
+       ex result;
+       size_t num = seq.size();
+       for (size_t i=0; i<num; i++) {
+               arg_diff = seq[i].diff(s);
+               // We apply the chain rule only when it makes sense.  This is not
+               // just for performance reasons but also to allow functions to
+               // throw when differentiated with respect to one of its arguments
+               // without running into trouble with our automatic full
+               // differentiation:
+               if (!arg_diff.is_zero()) {
+                       result += pderivative(i) * arg_diff;
+               }
+       }
+       return result;
+}
+
+ex function::pderivative(unsigned diff_param) const
+{
+       return function_derivative(lst(diff_param), *this).hold();
+}
+
+ex function::power_law(const ex& exp) const
+{
+       return power::power(*this, exp).hold();
+}
+
+ex function::expand(unsigned options) const
+{
+       return setflag(status_flags::expanded);
+//TODO??
+//    // Only expand arguments when asked to do so
+//    if (options & expand_options::expand_function_args)
+//        return inherited::expand(options);
+//    else
+//        return (options == 0) ? setflag(status_flags::expanded) : *this;
+}
+
+bool function::info(unsigned inf) const
+{
+       if (inf == info_flags::function) {
+               return true;
+       } else {
+               return inherited::info(inf);
+       }
+}
+
+void function::print(const print_context& c, unsigned level) const
+{
+       const std::vector<print_functor>& pdt = get_class_info().options.get_print_dispatch_table();
+       unsigned id = c.get_class_info().options.get_id();
+       if (id >= pdt.size() || !(pdt[id].is_valid())) {
+               if (is_a<print_tree>(c)) {
+                       c.s << std::string(level, ' ') << class_name()
+                               << " @" << this
+                               << std::hex << ", hash=0x" << hashvalue << ", flags=0x" << flags << std::dec
+                               << ", nops=" << nops()
+                               << std::endl;
+                       unsigned delta_indent = static_cast<const print_tree&>(c).delta_indent;
+                       for (size_t i=0; i<seq.size(); ++i) {
+                               seq[i].print(c, level + delta_indent);
+                       }
+                       c.s << std::string(level + delta_indent, ' ') << "=====" << std::endl;
+               } else if (is_a<print_latex>(c)) {
+                       c.s << "\\mbox{" << class_name() << "}";
+                       inherited::do_print(c,level);
+               } else {
+                       std::string classname(class_name());
+                       c.s << classname.erase(classname.find("_function",0),9);
+                       inherited::do_print(c,level);
+               }
+       } else {
+               pdt[id](*this, c, level);
+       }
+}
+
+} // namespace GiNaC
diff --git a/ginac/function.h b/ginac/function.h
new file mode 100644 (file)
index 0000000..7cacb58
--- /dev/null
@@ -0,0 +1,193 @@
+/** @file function.h
+ *
+ *  Interface to class of symbolic functions. */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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
+ */
+
+#ifndef __GINAC_FUNCTION_H__
+#define __GINAC_FUNCTION_H__
+
+#include "exprseq.h"
+
+#include <iostream>
+
+namespace GiNaC {
+
+class function : public exprseq
+{
+       GINAC_DECLARE_REGISTERED_CLASS_NO_CTORS(function, exprseq)
+public:
+       virtual function* duplicate() const;
+       virtual void accept(GiNaC::visitor& v) const;
+       function(const exvector& v) : exprseq(v) { tinfo_key = &function::tinfo_static; }
+       function(std::auto_ptr<exvector> vp) : exprseq(vp) { tinfo_key = &function::tinfo_static; }
+       function(tinfo_t ti, const exvector& vp) : exprseq(vp) { tinfo_key = ti; }
+       function(tinfo_t ti, std::auto_ptr<exvector> vp) : exprseq(vp) { tinfo_key = ti; }
+       ex thiscontainer(const exvector& v) const { return function(v); }
+       ex thiscontainer(std::auto_ptr<exvector> vp) const { return function(vp); }
+protected:
+       virtual int compare_same_type(const basic& other) const;
+       virtual bool is_equal_same_type(const basic& other) const;
+       virtual bool match_same_type(const basic & other) const;
+       virtual unsigned return_type() const;
+       virtual tinfo_t return_type_tinfo() const;
+public:
+       virtual ex conjugate() const;
+       virtual ex derivative(const symbol& s) const;
+       virtual ex pderivative(unsigned diff_param) const;
+       virtual ex expand(unsigned options) const;
+       virtual ex power_law(const ex& exp) const;
+public:
+       virtual bool info(unsigned inf) const;
+       virtual void print(const print_context& c, unsigned level = 0) const;
+public:
+       function() { }
+       function(tinfo_t ti) { tinfo_key = ti; }
+       function(tinfo_t ti, const ex& x1) : inherited(x1) { tinfo_key = ti; }
+       function(tinfo_t ti, const ex& x1, const ex& x2) : inherited(x1, x2) { tinfo_key = ti; }
+       function(tinfo_t ti, const ex& x1, const ex& x2, const ex& x3) : inherited(x1, x2, x3) { tinfo_key = ti; }
+       function(tinfo_t ti, const ex& x1, const ex& x2, const ex& x3, const ex& x4) : inherited(x1, x2, x3, x4) { tinfo_key = ti; }
+       function(tinfo_t ti, const ex& x1, const ex& x2, const ex& x3, const ex& x4, const ex& x5) : inherited(x1, x2, x3, x4, x5) { tinfo_key = ti; }
+       function(tinfo_t ti, const ex& x1, const ex& x2, const ex& x3, const ex& x4, const ex& x5, const ex& x6) : inherited(x1, x2, x3, x4, x5, x6) { tinfo_key = ti; }
+       function(tinfo_t ti, const ex& x1, const ex& x2, const ex& x3, const ex& x4, const ex& x5, const ex& x6, const ex& x7) : inherited(x1, x2, x3, x4, x5, x6, x7) { tinfo_key = ti; }
+       function(tinfo_t ti, const ex& x1, const ex& x2, const ex& x3, const ex& x4, const ex& x5, const ex& x6, const ex& x7, const ex& x8) : inherited(x1, x2, x3, x4, x5, x6, x7, x8) { tinfo_key = ti; }
+       function(tinfo_t ti, const ex& x1, const ex& x2, const ex& x3, const ex& x4, const ex& x5, const ex& x6, const ex& x7, const ex& x8, const ex& x9) : inherited(x1, x2, x3, x4, x5, x6, x7, x8, x9) { tinfo_key = ti; }
+       function(tinfo_t ti, const ex& x1, const ex& x2, const ex& x3, const ex& x4, const ex& x5, const ex& x6, const ex& x7, const ex& x8, const ex& x9, const ex& x10) : inherited(x1, x2, x3, x4, x5, x6, x7, x8, x9, x10) { tinfo_key = ti; }
+       function(tinfo_t ti, const ex& x1, const ex& x2, const ex& x3, const ex& x4, const ex& x5, const ex& x6, const ex& x7, const ex& x8, const ex& x9, const ex& x10, const ex& x11) : inherited(x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) { tinfo_key = ti; }
+       function(tinfo_t ti, const ex& x1, const ex& x2, const ex& x3, const ex& x4, const ex& x5, const ex& x6, const ex& x7, const ex& x8, const ex& x9, const ex& x10, const ex& x11, const ex& x12) : inherited(x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) { tinfo_key = ti; }
+};
+
+/** Macro for inclusion in the declaration of a GiNaC function. */
+#define GINAC_DECLARE_FUNCTION_NONSTD(classname) \
+public: \
+       typedef function inherited; \
+    static const tinfo_static_t tinfo_static; \
+private: \
+       static GiNaC::registered_class_info reg_info; \
+public: \
+       static GiNaC::registered_class_info& get_class_info_static() { return reg_info; } \
+       virtual const GiNaC::registered_class_info& get_class_info() const { return classname::get_class_info_static(); } \
+       virtual GiNaC::registered_class_info& get_class_info() { return classname::get_class_info_static(); } \
+       virtual const char* class_name() const { return classname::get_class_info_static().options.get_name(); } \
+       \
+       classname(const GiNaC::archive_node& n, GiNaC::lst& sym_lst) : inherited(n, sym_lst) { } \
+       virtual void archive(GiNaC::archive_node& n) const { inherited::archive(n); } \
+       static GiNaC::ex unarchive(const GiNaC::archive_node& n, GiNaC::lst& sym_lst) { return (new classname(n, sym_lst))->setflag(status_flags::dynallocated); } \
+       \
+       static GiNaC::ex factory(const exvector& args) { return (new classname(args))->setflag(status_flags::dynallocated); } \
+       \
+       class visitor { \
+       public: \
+               virtual void visit(const classname&) = 0; \
+               virtual ~visitor() {}; \
+       }; \
+       \
+       virtual void accept(GiNaC::visitor& v) const \
+       { \
+               if (visitor* p = dynamic_cast<visitor*>(&v)) \
+                       p->visit(*this); \
+               else \
+                       inherited::accept(v); \
+       } \
+       \
+       virtual classname* duplicate() const { return new classname(*this); } \
+private:
+
+#define GINAC_DECLARE_FUNCTION(classname) \
+GINAC_DECLARE_FUNCTION_NONSTD(classname) \
+public: \
+       classname(const exvector& v) : inherited(v) { tinfo_key = &classname::tinfo_static; } \
+       classname(std::auto_ptr<exvector> vp) : inherited(vp) { tinfo_key = &classname::tinfo_static; } \
+       ex thiscontainer(const exvector& v) const { return classname(v); } \
+       ex thiscontainer(std::auto_ptr<exvector> vp) const { return classname(vp); } \
+private:
+
+#define GINAC_FUNCTION_CTOR_1P(classname) \
+       public: \
+               classname(const ex& x1) : inherited(&classname::tinfo_static, x1) { }
+
+#define GINAC_FUNCTION_CTOR_2P(classname) \
+       public: \
+               classname(const ex& x1, const ex& x2) : inherited(&classname::tinfo_static, x1, x2) { } \
+
+#define GINAC_FUNCTION_CTOR_3P(classname) \
+       public: \
+               classname(const ex& x1, const ex& x2, const ex& x3) : inherited(&classname::tinfo_static, x1, x2, x3) { } \
+
+/** Macro for inclusion in the declaration of a GiNaC function with one parameter. */
+#define GINAC_DECLARE_FUNCTION_1P(classname) \
+       GINAC_DECLARE_FUNCTION(classname) \
+       GINAC_FUNCTION_CTOR_1P(classname) \
+       private:
+
+/** Macro for inclusion in the declaration of a GiNaC function with two parameters. */
+#define GINAC_DECLARE_FUNCTION_2P(classname) \
+       GINAC_DECLARE_FUNCTION(classname) \
+       GINAC_FUNCTION_CTOR_2P(classname) \
+       private:
+
+/** Macro for inclusion in the declaration of a GiNaC function with two parameters. */
+#define GINAC_DECLARE_FUNCTION_3P(classname) \
+       GINAC_DECLARE_FUNCTION(classname) \
+       GINAC_FUNCTION_CTOR_3P(classname) \
+       private:
+
+#define GINAC_FUNCTION_eval public: virtual ex eval(int level = 0) const;
+#define GINAC_FUNCTION_evalf public: virtual ex evalf(int level = 0) const;
+#define GINAC_FUNCTION_conjugate public: virtual ex conjugate() const;
+#define GINAC_FUNCTION_power_law public: virtual ex power_law(const ex& exp) const;
+#define GINAC_FUNCTION_series public: virtual ex series(const relational& r, int order, unsigned options = 0) const;
+#define GINAC_FUNCTION_print_dflt protected: void do_print_dflt(const print_context& c, unsigned level) const;
+#define GINAC_FUNCTION_print_csrc_float protected: void do_print_csrc_float(const print_context& c, unsigned level) const;
+#define GINAC_FUNCTION_print_latex protected: void do_print_latex(const print_context& c, unsigned level) const;
+
+#define GINAC_FUNCTION_1P(functionname, class_methods) \
+       class functionname##_function : public function \
+       { \
+       GINAC_DECLARE_FUNCTION_1P(functionname##_function) \
+       class_methods \
+       }; \
+       template<typename T1> inline functionname##_function functionname(const T1& x1) { return functionname##_function(x1); }
+
+#define GINAC_FUNCTION_2P(functionname, class_methods) \
+       class functionname##_function : public function \
+       { \
+       GINAC_DECLARE_FUNCTION_2P(functionname##_function) \
+       class_methods \
+       }; \
+       template<typename T1, typename T2> inline functionname##_function functionname(const T1& x1, const T2& x2) { return functionname##_function(x1, x2); }
+
+/** Macro for inclusion in the implementation of a GiNaC function. */
+#define GINAC_IMPLEMENT_FUNCTION(classname) \
+       GiNaC::registered_class_info classname::reg_info = GiNaC::registered_class_info(GiNaC::registered_class_options(#classname, "function", &classname::tinfo_static, &classname::unarchive).func_factory(&classname::factory)); \
+       const tinfo_static_t classname::tinfo_static = {};
+                       
+/** Macro for inclusion in the implementation of a GiNaC function.
+ *  Additional options can be specified. */
+#define GINAC_IMPLEMENT_FUNCTION_OPT(classname, options) \
+       GiNaC::registered_class_info classname::reg_info = GiNaC::registered_class_info(GiNaC::registered_class_options(#classname, "function", &classname::tinfo_static, &classname::unarchive).func_factory(&classname::factory).options); \
+       const tinfo_static_t classname::tinfo_static = {};
+
+/** Exception class thrown by classes which provide their own series expansion
+ *  to signal that ordinary Taylor expansion is safe. */
+class do_taylor {};
+
+} // namespace GiNaC
+
+#endif // ifndef __GINAC_FUNCTION_H__
diff --git a/ginac/function.pl b/ginac/function.pl
deleted file mode 100755 (executable)
index 06bf2d6..0000000
+++ /dev/null
@@ -1,657 +0,0 @@
-#!/usr/bin/perl -w
-
-$maxargs=10;
-
-sub generate_seq {
-    my ($seq_template,$n)=@_;
-    my ($res,$N);
-    
-    $res='';
-    for ($N=1; $N<=$n; $N++) {
-        $res .= eval('"' . $seq_template . '"');
-        if ($N!=$n) {
-            $res .= ', ';
-        }
-    }
-    return $res;
-}
-
-sub generate {
-    my ($template,$seq_template1,$seq_template2)=@_;
-    my ($res,$N,$SEQ);
-
-    $res='';
-    for ($N=1; $N<=$maxargs; $N++) {
-        $SEQ1=generate_seq($seq_template1,$N);
-        $SEQ2=generate_seq($seq_template2,$N);
-        $res .= eval('"' . $template . '"');
-        $SEQ1=''; # to avoid main::SEQ1 used only once warning
-        $SEQ2=''; # same as above
-    }
-    return $res;
-}
-
-$declare_function_macro=generate(
-    <<'END_OF_DECLARE_FUNCTION_MACRO','GiNaC::ex const & p${N}','p${N}');
-#define DECLARE_FUNCTION_${N}P(NAME) \\
-extern unsigned function_index_##NAME; \\
-inline GiNaC::function NAME(${SEQ1}) { \\
-    return GiNaC::function(function_index_##NAME, ${SEQ2}); \\
-}
-
-END_OF_DECLARE_FUNCTION_MACRO
-
-$typedef_eval_funcp=generate(
-'typedef ex (* eval_funcp_${N})(${SEQ1});'."\n",
-'ex const &','');
-
-$typedef_evalf_funcp=generate(
-'typedef ex (* evalf_funcp_${N})(${SEQ1});'."\n",
-'ex const &','');
-
-$typedef_diff_funcp=generate(
-'typedef ex (* diff_funcp_${N})(${SEQ1}, unsigned);'."\n",
-'ex const &','');
-
-$typedef_series_funcp=generate(
-'typedef ex (* series_funcp_${N})(${SEQ1}, symbol const &, ex const &, int);'."\n",
-'ex const &','');
-
-$constructors_interface=generate(
-'    function(unsigned ser, ${SEQ1});'."\n",
-'ex const & param${N}','');
-
-$register_new_interface=generate(
-'    static unsigned register_new(char const * nm, eval_funcp_${N} e,'."\n".
-'                                 evalf_funcp_${N} ef=0, diff_funcp_${N} d=0, series_funcp_${N} s=0);'.
-"\n",'','');
-
-$constructors_implementation=generate(
-    <<'END_OF_CONSTRUCTORS_IMPLEMENTATION','ex const & param${N}','param${N}');
-function::function(unsigned ser, ${SEQ1})
-    : exprseq(${SEQ2}), serial(ser)
-{
-    debugmsg(\"function constructor from unsigned,${N}*ex\",LOGLEVEL_CONSTRUCT);
-    tinfo_key = TINFO_function;
-}
-END_OF_CONSTRUCTORS_IMPLEMENTATION
-
-$eval_switch_statement=generate(
-    <<'END_OF_EVAL_SWITCH_STATEMENT','eseq[${N}-1]','');
-    case ${N}:
-        return ((eval_funcp_${N})(registered_functions()[serial].e))(${SEQ1});
-        break;
-END_OF_EVAL_SWITCH_STATEMENT
-
-$evalf_switch_statement=generate(
-    <<'END_OF_EVALF_SWITCH_STATEMENT','eseq[${N}-1]','');
-    case ${N}:
-        return ((evalf_funcp_${N})(registered_functions()[serial].ef))(${SEQ1});
-        break;
-END_OF_EVALF_SWITCH_STATEMENT
-
-$diff_switch_statement=generate(
-    <<'END_OF_DIFF_SWITCH_STATEMENT','seq[${N}-1]','');
-    case ${N}:
-        return ((diff_funcp_${N})(registered_functions()[serial].d))(${SEQ1},diff_param);
-        break;
-END_OF_DIFF_SWITCH_STATEMENT
-
-$series_switch_statement=generate(
-    <<'END_OF_SERIES_SWITCH_STATEMENT','seq[${N}-1]','');
-    case ${N}:
-        return ((series_funcp_${N})(registered_functions()[serial].s))(${SEQ1},s,point,order);
-        break;
-END_OF_SERIES_SWITCH_STATEMENT
-
-$register_new_implementation=generate(
-    <<'END_OF_REGISTER_NEW_IMPLEMENTATION','','');
-unsigned function::register_new(char const * nm, eval_funcp_${N} e,
-                                 evalf_funcp_${N} ef, diff_funcp_${N} d, series_funcp_${N} s)
-{
-    registered_function_info rfi={nm,${N},0,eval_funcp(e),
-                                  evalf_funcp(ef),diff_funcp(d),series_funcp(s)};
-    registered_functions().push_back(rfi);
-    return registered_functions().size()-1;
-}
-END_OF_REGISTER_NEW_IMPLEMENTATION
-
-$interface=<<END_OF_INTERFACE;
-/** \@file function.h
- *
- *  Interface to abstract class function (new function concept). */
-
-/*
- *  This file was generated automatically by function.pl.
- *  Please do not modify it directly, edit the perl script instead!
- *  function.pl options: \$maxargs=${maxargs}
- *
- *  GiNaC Copyright (C) 1999 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
- */
-
-#ifndef __GINAC_FUNCTION_H__
-#define __GINAC_FUNCTION_H__
-
-#include <string>
-#include <vector>
-#include <ginac/exprseq.h>
-
-// the following lines have been generated for max. ${maxargs} parameters
-$declare_function_macro
-// end of generated lines
-
-#define REGISTER_FUNCTION(NAME,E,EF,D,S) \\
-unsigned function_index_##NAME=GiNaC::function::register_new(#NAME,E,EF,D,S);
-
-#define BEGIN_TYPECHECK \\
-bool automatic_typecheck=true;
-
-#define TYPECHECK(VAR,TYPE) \\
-if (!is_ex_exactly_of_type(VAR,TYPE)) { \\
-    automatic_typecheck=false; \\
-} else
-
-#define TYPECHECK_INTEGER(VAR) \\
-if (!(VAR).info(GiNaC::info_flags::integer)) { \\
-    automatic_typecheck=false; \\
-} else
-
-#define END_TYPECHECK(RV) \\
-{} \\
-if (!automatic_typecheck) { \\
-    return RV.hold(); \\
-}
-
-namespace GiNaC {
-
-class function;
-
-typedef ex (* eval_funcp)();
-typedef ex (* evalf_funcp)();
-typedef ex (* diff_funcp)();
-typedef ex (* series_funcp)();
-
-// the following lines have been generated for max. ${maxargs} parameters
-$typedef_eval_funcp
-$typedef_evalf_funcp
-$typedef_diff_funcp
-$typedef_series_funcp
-// end of generated lines
-
-struct registered_function_info {
-    char const * name;
-    unsigned nparams;
-    unsigned options;
-    eval_funcp e;
-    evalf_funcp ef;
-    diff_funcp d;
-    series_funcp s;
-};
-
-/** The class function is used to implement builtin functions like sin, cos...
-    and user defined functions */
-class function : public exprseq
-{
-    friend void ginsh_get_ginac_functions(void);
-
-// member functions
-
-    // default constructor, destructor, copy constructor assignment operator and helpers
-public:
-    function();
-    ~function();
-    function(function const & other);
-    function const & operator=(function const & other);
-protected:
-    void copy(function const & other);
-    void destroy(bool call_parent);
-
-    // other constructors
-public:
-    function(unsigned ser);
-    // the following lines have been generated for max. ${maxargs} parameters
-$constructors_interface
-    // end of generated lines
-    function(unsigned ser, exprseq const & es);
-    function(unsigned ser, exvector const & v, bool discardable=0);
-    function(unsigned ser, exvector * vp); // vp will be deleted
-
-    // functions overriding virtual functions from bases classes
-public:
-    basic * duplicate() const;
-    void printraw(ostream & os) const; 
-    void print(ostream & os, unsigned upper_precedence=0) const;
-    void printtree(ostream & os, unsigned indent) const;
-    void printcsrc(ostream & os, unsigned type, unsigned upper_precedence=0) const;
-    ex expand(unsigned options=0) const;
-    ex eval(int level=0) const;
-    ex evalf(int level=0) const;
-    ex diff(symbol const & s) const;
-    ex series(symbol const & s, ex const & point, int order) const;
-    ex thisexprseq(exvector const & v) const;
-    ex thisexprseq(exvector * vp) const;
-protected:
-    int compare_same_type(basic const & other) const;
-    bool is_equal_same_type(basic const & other) const;
-    unsigned return_type(void) const;
-    unsigned return_type_tinfo(void) const;
-    
-    // new virtual functions which can be overridden by derived classes
-    // none
-    
-    // non-virtual functions in this class
-protected:
-    ex pdiff(unsigned diff_param) const; // partial differentiation
-    static vector<registered_function_info> & registered_functions(void);
-public:
-    // the following lines have been generated for max. ${maxargs} parameters
-$register_new_interface
-    // end of generated lines
-    unsigned getserial(void) const {return serial;}
-    
-// member variables
-
-protected:
-    unsigned serial;
-};
-
-// utility macros
-
-#define is_ex_the_function(OBJ, FUNCNAME) \\
-    (is_ex_exactly_of_type(OBJ, function) && static_cast<GiNaC::function *>(OBJ.bp)->getserial() == function_index_##FUNCNAME)
-
-// global constants
-
-extern const function some_function;
-extern type_info const & typeid_function;
-
-} // namespace GiNaC
-
-#endif // ndef __GINAC_FUNCTION_H__
-
-END_OF_INTERFACE
-
-$implementation=<<END_OF_IMPLEMENTATION;
-/** \@file function.cpp
- *
- *  Implementation of class function. */
-
-/*
- *  This file was generated automatically by function.pl.
- *  Please do not modify it directly, edit the perl script instead!
- *  function.pl options: \$maxargs=${maxargs}
- *
- *  GiNaC Copyright (C) 1999 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
- */
-
-#include <string>
-#include <stdexcept>
-
-#include "function.h"
-#include "ex.h"
-#include "debugmsg.h"
-
-namespace GiNaC {
-
-//////////
-// default constructor, destructor, copy constructor assignment operator and helpers
-//////////
-
-// public
-
-function::function() : serial(0)
-{
-    debugmsg("function default constructor",LOGLEVEL_CONSTRUCT);
-    tinfo_key = TINFO_function;
-}
-
-function::~function()
-{
-    debugmsg("function destructor",LOGLEVEL_DESTRUCT);
-    destroy(0);
-}
-
-function::function(function const & other)
-{
-    debugmsg("function copy constructor",LOGLEVEL_CONSTRUCT);
-    copy(other);
-}
-
-function const & function::operator=(function const & other)
-{
-    debugmsg("function operator=",LOGLEVEL_ASSIGNMENT);
-    if (this != &other) {
-        destroy(1);
-        copy(other);
-    }
-    return *this;
-}
-
-// protected
-
-void function::copy(function const & other)
-{
-    exprseq::copy(other);
-    serial=other.serial;
-}
-
-void function::destroy(bool call_parent)
-{
-    if (call_parent) exprseq::destroy(call_parent);
-}
-
-//////////
-// other constructors
-//////////
-
-// public
-
-function::function(unsigned ser) : serial(ser)
-{
-    debugmsg("function constructor from unsigned",LOGLEVEL_CONSTRUCT);
-    tinfo_key = TINFO_function;
-}
-
-// the following lines have been generated for max. ${maxargs} parameters
-$constructors_implementation
-// end of generated lines
-
-function::function(unsigned ser, exprseq const & es) : exprseq(es), serial(ser)
-{
-    debugmsg("function constructor from unsigned,exprseq",LOGLEVEL_CONSTRUCT);
-    tinfo_key = TINFO_function;
-}
-
-function::function(unsigned ser, exvector const & v, bool discardable) 
-    : exprseq(v,discardable), serial(ser)
-{
-    debugmsg("function constructor from string,exvector,bool",LOGLEVEL_CONSTRUCT);
-    tinfo_key = TINFO_function;
-}
-
-function::function(unsigned ser, exvector * vp) 
-    : exprseq(vp), serial(ser)
-{
-    debugmsg("function constructor from unsigned,exvector *",LOGLEVEL_CONSTRUCT);
-    tinfo_key = TINFO_function;
-}
-
-//////////
-// functions overriding virtual functions from bases classes
-//////////
-
-// public
-
-basic * function::duplicate() const
-{
-    debugmsg("function duplicate",LOGLEVEL_DUPLICATE);
-    return new function(*this);
-}
-
-void function::printraw(ostream & os) const
-{
-    debugmsg("function printraw",LOGLEVEL_PRINT);
-
-    GINAC_ASSERT(serial<registered_functions().size());
-
-    os << "function(name=" << registered_functions()[serial].name;
-    for (exvector::const_iterator it=seq.begin(); it!=seq.end(); ++it) {
-        os << ",";
-        (*it).bp->print(os);
-    }
-    os << ")";
-}
-
-void function::print(ostream & os, unsigned upper_precedence) const
-{
-    debugmsg("function print",LOGLEVEL_PRINT);
-
-    GINAC_ASSERT(serial<registered_functions().size());
-
-    os << registered_functions()[serial].name;
-    printseq(os,'(',',',')',exprseq::precedence,function::precedence);
-}
-
-void function::printtree(ostream & os, unsigned indent) const
-{
-    debugmsg("function printtree",LOGLEVEL_PRINT);
-
-    GINAC_ASSERT(serial<registered_functions().size());
-
-    os << string(indent,' ') << "function "
-       << registered_functions()[serial].name
-       << ", hash=" << hashvalue << " (0x" << hex << hashvalue << dec << ")"
-       << ", flags=" << flags
-       << ", nops=" << nops() << endl;
-    for (int i=0; i<nops(); ++i) {
-        seq[i].printtree(os,indent+delta_indent);
-    }
-    os << string(indent+delta_indent,' ') << "=====" << endl;
-}
-
-void function::printcsrc(ostream & os, unsigned type, unsigned upper_precedence) const
-{
-    debugmsg("function print csrc",LOGLEVEL_PRINT);
-
-    GINAC_ASSERT(serial<registered_functions().size());
-
-       // Print function name in lowercase
-    string lname;
-    lname=registered_functions()[serial].name;
-    for (unsigned i=0; i<lname.size(); i++)
-        lname[i] = tolower(lname[i]);
-    os << lname << "(";
-
-       // Print arguments, separated by commas
-    exvector::const_iterator it = seq.begin();
-    exvector::const_iterator itend = seq.end();
-    while (it != itend) {
-        it->bp->printcsrc(os, type, 0);
-        it++;
-        if (it != itend)
-            os << ",";
-    }
-    os << ")";
-}
-
-ex function::expand(unsigned options) const
-{
-    return this->setflag(status_flags::expanded);
-}
-
-ex function::eval(int level) const
-{
-    GINAC_ASSERT(serial<registered_functions().size());
-
-    exvector eseq=evalchildren(level);    
-
-    if (registered_functions()[serial].e==0) {
-        return function(serial,eseq).hold();
-    }
-    switch (registered_functions()[serial].nparams) {
-        // the following lines have been generated for max. ${maxargs} parameters
-${eval_switch_statement}
-        // end of generated lines
-    }
-    throw(std::logic_error("function::eval(): invalid nparams"));
-}
-
-ex function::evalf(int level) const
-{
-    GINAC_ASSERT(serial<registered_functions().size());
-
-    exvector eseq=evalfchildren(level);
-    
-    if (registered_functions()[serial].ef==0) {
-        return function(serial,eseq).hold();
-    }
-    switch (registered_functions()[serial].nparams) {
-        // the following lines have been generated for max. ${maxargs} parameters
-${evalf_switch_statement}
-        // end of generated lines
-    }
-    throw(std::logic_error("function::evalf(): invalid nparams"));
-}
-
-ex function::thisexprseq(exvector const & v) const
-{
-    return function(serial,v);
-}
-
-ex function::thisexprseq(exvector * vp) const
-{
-    return function(serial,vp);
-}
-
-/** Implementation of ex::series for functions.
- *  \@see ex::series */
-ex function::series(symbol const & s, ex const & point, int order) const
-{
-    GINAC_ASSERT(serial<registered_functions().size());
-
-    if (registered_functions()[serial].s==0) {
-        return basic::series(s, point, order);
-    }
-    switch (registered_functions()[serial].nparams) {
-        // the following lines have been generated for max. ${maxargs} parameters
-${series_switch_statement}
-        // end of generated lines
-    }
-    throw(std::logic_error("function::series(): invalid nparams"));
-}
-
-// protected
-
-int function::compare_same_type(basic const & other) const
-{
-    GINAC_ASSERT(is_of_type(other, function));
-    function const & o=static_cast<function &>(const_cast<basic &>(other));
-
-    if (serial!=o.serial) {
-        return serial < o.serial ? -1 : 1;
-    }
-    return exprseq::compare_same_type(o);
-}
-
-bool function::is_equal_same_type(basic const & other) const
-{
-    GINAC_ASSERT(is_of_type(other, function));
-    function const & o=static_cast<function &>(const_cast<basic &>(other));
-
-    if (serial!=o.serial) return false;
-    return exprseq::is_equal_same_type(o);
-}
-
-unsigned function::return_type(void) const
-{
-    if (seq.size()==0) {
-        return return_types::commutative;
-    }
-    return (*seq.begin()).return_type();
-}
-   
-unsigned function::return_type_tinfo(void) const
-{
-    if (seq.size()==0) {
-        return tinfo_key;
-    }
-    return (*seq.begin()).return_type_tinfo();
-}
-
-//////////
-// new virtual functions which can be overridden by derived classes
-//////////
-
-// none
-
-//////////
-// non-virtual functions in this class
-//////////
-
-// protected
-
-ex function::pdiff(unsigned diff_param) const // partial differentiation
-{
-    GINAC_ASSERT(serial<registered_functions().size());
-    
-    if (registered_functions()[serial].d==0) {
-        throw(std::logic_error(string("function::pdiff(") + registered_functions()[serial].name + "): no diff function defined"));
-    }
-    switch (registered_functions()[serial].nparams) {
-        // the following lines have been generated for max. ${maxargs} parameters
-${diff_switch_statement}
-        // end of generated lines
-    }        
-    throw(std::logic_error("function::pdiff(): no diff function defined"));
-}
-
-vector<registered_function_info> & function::registered_functions(void)
-{
-    static vector<registered_function_info> * rf=new vector<registered_function_info>;
-    return *rf;
-}
-
-// public
-
-// the following lines have been generated for max. ${maxargs} parameters
-$register_new_implementation
-// end of generated lines
-
-//////////
-// static member variables
-//////////
-
-// none
-
-//////////
-// global constants
-//////////
-
-const function some_function;
-type_info const & typeid_function=typeid(some_function);
-
-} // namespace GiNaC
-
-END_OF_IMPLEMENTATION
-
-print "Creating interface file function.h...";
-open OUT,">function.h" or die "cannot open function.h";
-print OUT $interface;
-close OUT;
-print "ok.\n";
-
-print "Creating implementation file function.cpp...";
-open OUT,">function.cpp" or die "cannot open function.cpp";
-print OUT $implementation;
-close OUT;
-print "ok.\n";
-
-print "done.\n";
index 23864bc21fd959a718ef0cf6ff140c2e85398cff..c3deb21f6d3b3ec9949a0a99779cf41fe2eb03dc 100644 (file)
@@ -3,7 +3,7 @@
  *  This include file includes all other public GiNaC headers. */
 
 /*
- *  GiNaC Copyright (C) 1999 Johannes Gutenberg University Mainz, Germany
+ *  GiNaC Copyright (C) 1999-2006 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
  *
  *  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  */
 
 #ifndef __GINAC_H__
 #define __GINAC_H__
 
-#include <ginac/basic.h>
+#include "version.h"
 
-#include <ginac/ex.h>
-#include <ginac/normal.h>
+#include "basic.h"
 
-#include <ginac/constant.h>
-#include <ginac/fail.h>
-#include <ginac/idx.h>
-#include <ginac/lst.h>
-#include <ginac/matrix.h>
-#include <ginac/numeric.h>
-#include <ginac/power.h>
-#include <ginac/relational.h>
-#include <ginac/structure.h>
-#include <ginac/symbol.h>
+#include "ex.h"
+#include "normal.h"
+#include "archive.h"
+#include "print.h"
 
-#include <ginac/expair.h>
-#include <ginac/expairseq.h>
-#include <ginac/add.h>
-#include <ginac/mul.h>
-#include <ginac/series.h>
+#include "constant.h"
+#include "fail.h"
+#include "integral.h"
+#include "lst.h"
+#include "matrix.h"
+#include "numeric.h"
+#include "power.h"
+#include "relational.h"
+#include "structure.h"
+#include "symbol.h"
+#include "pseries.h"
+#include "wildcard.h"
+#include "symmetry.h"
 
-#include <ginac/exprseq.h>
-#include <ginac/function.h>
-#include <ginac/ncmul.h>
+#include "expair.h"
+#include "expairseq.h"
+#include "add.h"
+#include "mul.h"
 
-#include <ginac/inifcns.h>
-#include <ginac/operators.h>
+#include "exprseq.h"
+#include "function.h"
+#include "ncmul.h"
 
-#ifndef GINAC_BASE_ONLY
-#include <ginac/indexed.h>
-#include <ginac/clifford.h>
-#include <ginac/coloridx.h>
-#include <ginac/color.h>
-#include <ginac/isospin.h>
-#include <ginac/lorentzidx.h>
-#include <ginac/simp_lor.h>
-#endif // ndef GINAC_BASE_ONLY
+#include "inifcns.h"
+#include "inifcns_trig.h"
+#include "inifcns_exp.h"
+#include "inifcns_polylog.h"
+#include "operators.h"
+#include "hash_map.h"
+
+#include "idx.h"
+#include "indexed.h"
+#include "tensor.h"
+#include "color.h"
+#include "clifford.h"
+
+#include "excompiler.h"
+
+#ifdef __MAKECINT__
+#pragma link C++ nestedclass;
+#pragma link C++ nestedtypedef;
+#endif
 
 #endif // ndef __GINAC_H__
index 3f67d848cb199d3742dcf510340c083e00eb4b74..944ee5da9604a14b66a785b8805bd107e157808a 100644 (file)
@@ -3,7 +3,7 @@
  *  Implementation of GiNaC's initially known functions. */
 
 /*
- *  GiNaC Copyright (C) 1999 Johannes Gutenberg University Mainz, Germany
+ *  GiNaC Copyright (C) 1999-2006 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
  *
  *  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  */
 
-#include <vector>
-#include <stdexcept>
-
 #include "inifcns.h"
+
 #include "ex.h"
 #include "constant.h"
 #include "lst.h"
 #include "matrix.h"
 #include "mul.h"
-#include "ncmul.h"
-#include "numeric.h"
 #include "power.h"
+#include "operators.h"
 #include "relational.h"
-#include "series.h"
+#include "pseries.h"
 #include "symbol.h"
+#include "symmetry.h"
+#include "utils.h"
+
+#include <stdexcept>
+#include <vector>
 
 namespace GiNaC {
 
 //////////
-// dilogarithm
+// absolute value
 //////////
 
-static ex Li2_eval(ex const & x)
+GINAC_IMPLEMENT_FUNCTION_OPT(abs_function,
+               print_func<print_csrc_float>(&abs_function::do_print_csrc_float).
+               print_func<print_latex>(&abs_function::do_print_latex))
+
+ex abs_function::conjugate() const
+{
+       return *this;
+}
+
+ex abs_function::eval(int level) const
+{
+       const ex& arg = seq[0];
+       if (is_exactly_a<numeric>(arg))
+               return abs(ex_to<numeric>(arg));
+       else
+               return this->hold();
+}
+
+ex abs_function::evalf(int level) const
+{
+       const ex& arg = seq[0];
+       if (is_exactly_a<numeric>(arg)) {
+               return abs(ex_to<numeric>(arg));
+       }
+       
+       return this->hold();
+}
+
+ex abs_function::power_law(const ex& exp) const
 {
-    if (x.is_zero())
-        return x;
-    if (x.is_equal(exONE()))
-        return power(Pi, 2) / 6;
-    if (x.is_equal(exMINUSONE()))
-        return -power(Pi, 2) / 12;
-    return Li2(x).hold();
+       const ex& arg = seq[0];
+       if (arg.is_equal(arg.conjugate()) && is_a<numeric>(exp) && ex_to<numeric>(exp).is_even())
+               return power(arg, exp);
+       else
+               return power(abs(arg), exp).hold();
 }
 
-REGISTER_FUNCTION(Li2, Li2_eval, NULL, NULL, NULL);
+void abs_function::do_print_csrc_float(const print_context& c, unsigned level) const
+{
+       c.s << "fabs("; seq[0].print(c); c.s << ")";
+}
+
+void abs_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "{|"; seq[0].print(c); c.s << "|}";
+}
 
 //////////
-// trilogarithm
+// complex conjugate
 //////////
 
-static ex Li3_eval(ex const & x)
+GINAC_IMPLEMENT_FUNCTION_OPT(conjugate_function,
+               print_func<print_latex>(&conjugate_function::do_print_latex))
+
+ex conjugate_function::conjugate() const
+{
+       return seq[0];
+}
+
+ex conjugate_function::eval(int level) const
 {
-    if (x.is_zero())
-        return x;
-    return Li3(x).hold();
+       return seq[0].conjugate();
 }
 
-REGISTER_FUNCTION(Li3, Li3_eval, NULL, NULL, NULL);
+ex conjugate_function::evalf(int level) const
+{
+       const ex& arg = seq[0];
+       if (is_exactly_a<numeric>(arg)) {
+               return ex_to<numeric>(arg).conjugate();
+       }
+       return this->hold();
+}
+
+void conjugate_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       const ex& arg = seq[0];
+       c.s << "\\bar{"; arg.print(c); c.s << "}";
+}
+
+//////////
+// Complex sign
+//////////
+
+GINAC_IMPLEMENT_FUNCTION(csgn_function)
+
+ex csgn_function::conjugate() const
+{
+       return *this;
+}
+
+ex csgn_function::eval(int level) const
+{
+       const ex& arg = seq[0];
+
+       if (is_exactly_a<numeric>(arg))
+               return csgn(ex_to<numeric>(arg));
+       
+       else if (is_exactly_a<mul>(arg) &&
+                is_exactly_a<numeric>(arg.op(arg.nops()-1))) {
+               numeric oc = ex_to<numeric>(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 this->hold();
+}
+
+ex csgn_function::evalf(int level) const
+{
+       const ex& arg = seq[0];
+       if (is_exactly_a<numeric>(arg))
+               return csgn(ex_to<numeric>(arg));
+       
+       return this->hold();
+}
+
+ex csgn_function::power_law(const ex& exp) const
+{
+       const ex& arg = seq[0];
+       if (is_a<numeric>(exp) && exp.info(info_flags::positive) && ex_to<numeric>(exp).is_integer()) {
+               if (ex_to<numeric>(exp).is_odd())
+                       return *this;
+               else
+                       return power(*this, _ex2).hold();
+       } else
+               return power(*this, exp).hold();
+}
+
+ex csgn_function::series(const relational& r, int order, unsigned options) const
+{
+       const ex& arg = seq[0];
+       const ex arg_pt = arg.subs(r, subs_options::no_pattern);
+       if (arg_pt.info(info_flags::numeric)
+           && ex_to<numeric>(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(r, seq);
+}
+
+//////////
+// Step function
+//////////
+
+GINAC_IMPLEMENT_FUNCTION(step_function)
+
+ex step_function::conjugate() const
+{
+       return *this;
+}
+
+ex step_function::eval(int level) const
+{
+       const ex& arg = seq[0];
+
+       if (is_exactly_a<numeric>(arg))
+               return step(ex_to<numeric>(arg));
+       
+       else if (is_exactly_a<mul>(arg) &&
+                is_exactly_a<numeric>(arg.op(arg.nops()-1))) {
+               numeric oc = ex_to<numeric>(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 this->hold();
+}
+
+ex step_function::evalf(int level) const
+{
+       const ex& arg = seq[0];
+       if (is_exactly_a<numeric>(arg))
+               return step(ex_to<numeric>(arg));
+       
+       return this->hold();
+}
+
+ex step_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& arg = seq[0];
+       const ex arg_pt = arg.subs(rel, subs_options::no_pattern);
+       if (arg_pt.info(info_flags::numeric)
+           && ex_to<numeric>(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);
+}
 
 //////////
 // factorial
 //////////
 
-static ex factorial_evalf(ex const & x)
+GINAC_IMPLEMENT_FUNCTION_OPT(factorial_function,
+               print_func<print_dflt>(&factorial_function::do_print_dflt_latex).
+               print_func<print_latex>(&factorial_function::do_print_dflt_latex))
+
+ex factorial_function::conjugate() const
 {
-    return factorial(x).hold();
+       return *this;
 }
 
-static ex factorial_eval(ex const & x)
+ex factorial_function::eval(int level) const
 {
-    if (is_ex_exactly_of_type(x, numeric))
-        return factorial(ex_to_numeric(x));
-    else
-        return factorial(x).hold();
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x))
+               return factorial(ex_to<numeric>(x));
+       else
+               return this->hold();
 }
 
-REGISTER_FUNCTION(factorial, factorial_eval, factorial_evalf, NULL, NULL);
+ex factorial_function::evalf(int level) const
+{
+       return this->hold();
+}
+
+void factorial_function::do_print_dflt_latex(const print_context& c, unsigned level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<symbol>(x) || is_exactly_a<constant>(x) || is_exactly_a<function>(x)) {
+               x.print(c); c.s << "!";
+       } else {
+               c.s << "("; x.print(c); c.s << ")!";
+       }
+}
 
 //////////
 // binomial
 //////////
 
-static ex binomial_evalf(ex const & x, ex const & y)
+GINAC_IMPLEMENT_FUNCTION(binomial_function)
+
+// 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).
+ex binomial_function::conjugate() const
 {
-    return binomial(x, y).hold();
+       return *this;
 }
 
-static ex binomial_eval(ex const & x, ex const &y)
+ex binomial_function::sym(const ex& x, const numeric& y) const
 {
-    if (is_ex_exactly_of_type(x, numeric) && is_ex_exactly_of_type(y, numeric))
-        return binomial(ex_to_numeric(x), ex_to_numeric(y));
-    else
-        return binomial(x, y).hold();
+       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 this->hold();
 }
 
-REGISTER_FUNCTION(binomial, binomial_eval, binomial_evalf, NULL, NULL);
+ex binomial_function::eval(int level) const
+{
+       const ex& x = seq[0];
+       const ex& y = seq[1];
+       if (is_exactly_a<numeric>(y)) {
+               if (is_exactly_a<numeric>(x) && ex_to<numeric>(x).is_integer())
+                       return binomial(ex_to<numeric>(x), ex_to<numeric>(y));
+               else
+                       return sym(x, ex_to<numeric>(y));
+       } else
+               return this->hold();
+}
+
+ex binomial_function::evalf(int level) const
+{
+       return this->hold();
+}
 
 //////////
 // Order term function (for truncated power series)
 //////////
 
-static ex Order_eval(ex const & x)
+GINAC_IMPLEMENT_FUNCTION_OPT(Order_function,
+               print_func<print_latex>(&Order_function::do_print_latex))
+
+ex Order_function::conjugate() const
+{
+       return *this;
+}
+
+ex Order_function::derivative(const symbol& s) const
+{
+       return Order(seq[0].diff(s));
+}
+
+ex Order_function::eval(int level) const
 {
-       if (is_ex_exactly_of_type(x, numeric)) {
+       const ex& x = op(0);
+       if (is_exactly_a<numeric>(x)) {
+               // O(c) -> O(1) or 0
+               if (!x.is_zero())
+                       return Order(_ex1).hold();
+               else
+                       return _ex0;
+       } else if (is_exactly_a<mul>(x)) {
+               const mul& m = ex_to<mul>(x);
+               // O(c*expr) -> O(expr)
+               if (is_exactly_a<numeric>(m.op(m.nops() - 1)))
+                       return Order(x / m.op(m.nops() - 1)).hold();
+       }
+       return this->hold();
+}
+
+ex Order_function::series(const relational& r, int order, unsigned options) const
+{
+       const ex& x = op(0);
+       // Just wrap the function into a pseries object
+       epvector new_seq;
+       GINAC_ASSERT(is_a<symbol>(r.lhs()));
+       const symbol& s = ex_to<symbol>(r.lhs());
+       new_seq.push_back(expair(Order(_ex1), numeric(std::min(x.ldegree(s), order))));
+       return pseries(r, new_seq);
+}
 
-               // O(c)=O(1)
-               return Order(exONE()).hold();
+void Order_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\mathcal{O}";
+       inherited::do_print(c,level);
+}
 
-       } else if (is_ex_exactly_of_type(x, mul)) {
+//////////
+// Abstract derivative of functions
+//////////
 
-               mul *m = static_cast<mul *>(x.bp);
-               if (is_ex_exactly_of_type(m->op(m->nops() - 1), numeric)) {
+GINAC_IMPLEMENT_FUNCTION_OPT(function_derivative_function,
+               print_func<print_dflt>(&function_derivative_function::do_print_dflt).
+               print_func<print_tree>(&function_derivative_function::do_print_tree))
 
-                       // O(c*expr)=O(expr)
-                       return Order(x / m->op(m->nops() - 1)).hold();
+/** Implementation of ex::diff() for derivatives. It applies the chain rule.
+ *  @see ex::diff */
+ex function_derivative_function::derivative(const symbol& s) const
+{
+       GINAC_ASSERT(seq[0].size() == 2);
+       GINAC_ASSERT(is_a<lst>(seq[0]));
+       GINAC_ASSERT(is_a<function>(seq[1]));
+
+       const ex& func = seq[1];
+       ex result;
+       for (size_t i=0; i<func.nops(); ++i) {
+               ex arg_diff = func.op(i).diff(s);
+               if (!arg_diff.is_zero()) {
+                       lst params = ex_to<lst>(seq[0]);
+                       params.append(i);
+                       params.sort();
+                       result += arg_diff * function_derivative(params, func);
                }
        }
-       return Order(x).hold();
+       return result;
 }
 
-static ex Order_series(ex const & x, symbol const & s, ex const & point, int order)
+ex function_derivative_function::eval(int level) const
 {
-       // Just wrap the function into a series object
-       epvector new_seq;
-       new_seq.push_back(expair(Order(exONE()), numeric(min(x.ldegree(s), order))));
-       return series(s, point, new_seq);
-}
-
-REGISTER_FUNCTION(Order, Order_eval, NULL, NULL, Order_series);
-
-/** linear solve. */
-ex lsolve(ex const &eqns, ex const &symbols)
-{
-    // 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"));
-        }
-        ex sol=lsolve(lst(eqns),lst(symbols));
-        
-        GINAC_ASSERT(sol.nops()==1);
-        GINAC_ASSERT(is_ex_exactly_of_type(sol.op(0),relational));
-        
-        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 (int i=0; i<eqns.nops(); i++) {
-        if (!eqns.op(i).info(info_flags::relation_equal)) {
-            throw(std::invalid_argument("lsolve: 1st argument must be a list of equations"));
-        }
-    }
-    if (!symbols.info(info_flags::list)) {
-        throw(std::invalid_argument("lsolve: 2nd argument must be a list"));
-    }
-    for (int i=0; i<symbols.nops(); i++) {
-        if (!symbols.op(i).info(info_flags::symbol)) {
-            throw(std::invalid_argument("lsolve: 2nd argument must be a list of symbols"));
-        }
-    }
-    
-    // build matrix from equation system
-    matrix sys(eqns.nops(),symbols.nops());
-    matrix rhs(eqns.nops(),1);
-    matrix vars(symbols.nops(),1);
-
-    for (int r=0; r<eqns.nops(); r++) {
-        ex eq=eqns.op(r).op(0)-eqns.op(r).op(1); // lhs-rhs==0
-        ex linpart=eq;
-        for (int c=0; c<symbols.nops(); c++) {
-            ex co=eq.coeff(ex_to_symbol(symbols.op(c)),1);
-            linpart -= co*symbols.op(c);
-            sys.set(r,c,co);
-        }
-        linpart=linpart.expand();
-        rhs.set(r,0,-linpart);
-    }
-    
-    // test if system is linear and fill vars matrix
-    for (int i=0; i<symbols.nops(); i++) {
-        vars.set(i,0,symbols.op(i));
-        if (sys.has(symbols.op(i))) {
-            throw(std::logic_error("lsolve: system is not linear"));
-        }
-        if (rhs.has(symbols.op(i))) {
-            throw(std::logic_error("lsolve: system is not linear"));
-        }
-    }
-    
-    //matrix solution=sys.solve(rhs);
-    matrix solution;
-    try {
-        solution=sys.fraction_free_elim(vars,rhs);
-    } catch (runtime_error const & e) {
-        // probably singular matrix (or other error)
-        // return empty solution list
-        // cerr << e.what() << endl;
-        return lst();
-    }
-    
-    // return a list of equations
-    if (solution.cols()!=1) {
-        throw(std::runtime_error("lsolve: strange number of columns returned from matrix::solve"));
-    }
-    if (solution.rows()!=symbols.nops()) {
-        cout << "symbols.nops()=" << symbols.nops() << endl;
-        cout << "solution.rows()=" << solution.rows() << endl;
-        throw(std::runtime_error("lsolve: strange number of rows returned from matrix::solve"));
-    }
-    
-    // return list of the form lst(var1==sol1,var2==sol2,...)
-    lst sollist;
-    for (int i=0; i<symbols.nops(); i++) {
-        sollist.append(symbols.op(i)==solution(i,0));
-    }
-    
-    return sollist;
-}
-
-/** non-commutative power. */
-ex ncpower(ex const &basis, unsigned exponent)
-{
-    if (exponent==0) {
-        return exONE();
-    }
-
-    exvector v;
-    v.reserve(exponent);
-    for (unsigned i=0; i<exponent; ++i) {
-        v.push_back(basis);
-    }
-
-    return ncmul(v,1);
-}
-
-/** Force inclusion of functions from initcns_gamma and inifcns_zeta
- *  for static lib (so ginsh will see them). */
-unsigned force_include_gamma = function_index_gamma;
-unsigned force_include_zeta = function_index_zeta;
+       if (level > 1) {
+               // first evaluate children, then we will end up here again
+               return function_derivative_function(evalchildren(level));
+       }
+
+       const ex& params = seq[0];
+       // No parameters specified? Then return the function itself
+       if (params.nops() == 0) {
+               return seq[1];
+       }
+
+       if (params.nops() == 1) {
+               return ex_to<function>(seq[1]).pderivative((ex_to<numeric>(params.op(0))).to_int());
+       }
+       
+       return this->hold();
+}
+
+void function_derivative_function::do_print_dflt(const print_context& c, unsigned level) const
+{
+       c.s << "D[";
+       const lst& params = ex_to<lst>(seq[0]);
+       lst::const_iterator i = params.begin(), end = params.end();
+       --end;
+       while (i != end) {
+               c.s << *i++ << ",";
+       }
+       c.s << *i << "](" << seq[1] << ")";
+}
+
+void function_derivative_function::do_print_tree(const print_tree& c, unsigned level) const
+{
+       c.s << std::string(level, ' ') << class_name() << " "
+           << ex_to<function>(seq[1]).class_name() << " @" << this
+           << std::hex << ", hash=0x" << hashvalue << ", flags=0x" << flags << std::dec
+           << ", nops=" << nops() << std::endl;
+       seq[0].print(c, level + c.delta_indent);
+       for (size_t i=0; i<seq[1].nops(); ++i)
+               seq[1].op(i).print(c, level + c.delta_indent);
+       c.s << std::string(level + c.delta_indent, ' ') << "=====" << std::endl;
+}
+
+//////////
+// 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<relational>(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<eqns.nops(); i++) {
+               if (!eqns.op(i).info(info_flags::relation_equal)) {
+                       throw(std::invalid_argument("lsolve(): 1st argument must be a list of equations"));
+               }
+       }
+       if (!symbols.info(info_flags::list)) {
+               throw(std::invalid_argument("lsolve(): 2nd argument must be a list"));
+       }
+       for (size_t i=0; i<symbols.nops(); i++) {
+               if (!symbols.op(i).info(info_flags::symbol)) {
+                       throw(std::invalid_argument("lsolve(): 2nd argument must be a list of symbols"));
+               }
+       }
+       
+       // build matrix from equation system
+       matrix sys(eqns.nops(),symbols.nops());
+       matrix rhs(eqns.nops(),1);
+       matrix vars(symbols.nops(),1);
+       
+       for (size_t r=0; r<eqns.nops(); r++) {
+               const ex eq = eqns.op(r).op(0)-eqns.op(r).op(1); // lhs-rhs==0
+               ex linpart = eq;
+               for (size_t c=0; c<symbols.nops(); c++) {
+                       const ex co = eq.coeff(ex_to<symbol>(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<symbols.nops(); i++) {
+               vars(i,0) = symbols.op(i);
+               if (sys.has(symbols.op(i)))
+                       throw(std::logic_error("lsolve: system is not linear"));
+               if (rhs.has(symbols.op(i)))
+                       throw(std::logic_error("lsolve: system is not linear"));
+       }
+       
+       matrix solution;
+       try {
+               solution = sys.solve(vars,rhs,options);
+       } catch (const std::runtime_error & e) {
+               // Probably singular matrix or otherwise overdetermined system:
+               // It is consistent to return an empty list
+               return lst();
+       }
+       GINAC_ASSERT(solution.cols()==1);
+       GINAC_ASSERT(solution.rows()==symbols.nops());
+       
+       // return list of equations of the form lst(var1==sol1,var2==sol2,...)
+       lst sollist;
+       for (size_t i=0; i<symbols.nops(); i++)
+               sollist.append(symbols.op(i)==solution(i,0));
+       
+       return sollist;
+}
+
+//////////
+// Find real root of f(x) numerically
+//////////
+
+const numeric fsolve(const ex& f_in, const symbol& x, const numeric& x1, const numeric& x2)
+{
+       if (!x1.is_real() || !x2.is_real()) {
+               throw std::runtime_error("fsolve(): interval not bounded by real numbers");
+       }
+       if (x1==x2) {
+               throw std::runtime_error("fsolve(): vanishing interval");
+       }
+       // xx[0] == left interval limit, xx[1] == right interval limit.
+       // fx[0] == f(xx[0]), fx[1] == f(xx[1]).
+       // We keep the root bracketed: xx[0]<xx[1] and fx[0]*fx[1]<0.
+       numeric xx[2] = { x1<x2 ? x1 : x2,
+                         x1<x2 ? x2 : x1 };
+       ex f;
+       if (is_a<relational>(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<numeric>(fx_[0]) || !is_a<numeric>(fx_[1])) {
+               throw std::runtime_error("fsolve(): function does not evaluate numerically");
+       }
+       numeric fx[2] = { ex_to<numeric>(fx_[0]),
+                         ex_to<numeric>(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<numeric>(ff.subs(x==xx[side]).evalf());
+               fx[side] = ex_to<numeric>(f.subs(x==xx[side]).evalf());
+               if ((side==0 && xx[0]<xxprev) || (side==1 && xx[1]>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<numeric>(ff.subs(x==xx[side]).evalf());
+                       fx[side] = ex_to<numeric>(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<numeric>(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;
+}
 
 } // namespace GiNaC
index ee7378180684df7fc2abf2d0df95696cc46e96ca..1f6761b70ea081a24fb8f710f27a514a891fa1a8 100644 (file)
@@ -3,7 +3,7 @@
  *  Interface to GiNaC's initially known functions. */
 
 /*
- *  GiNaC Copyright (C) 1999 Johannes Gutenberg University Mainz, Germany
+ *  GiNaC Copyright (C) 1999-2006 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
  *
  *  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  */
 
 #ifndef __GINAC_INIFCNS_H__
 #define __GINAC_INIFCNS_H__
 
-#include <ginac/function.h>
-#include <ginac/ex.h>
+#include "numeric.h"
+#include "function.h"
+#include "ex.h"
 
 namespace GiNaC {
 
-/** Sine. */
-DECLARE_FUNCTION_1P(sin)
-
-/** Cosine. */
-DECLARE_FUNCTION_1P(cos)
-
-/** Tangent. */
-DECLARE_FUNCTION_1P(tan)
-
-/** Exponential function. */
-DECLARE_FUNCTION_1P(exp)
-
-/** Natural logarithm. */
-DECLARE_FUNCTION_1P(log)
-
-/** Inverse sine (arc sine). */
-DECLARE_FUNCTION_1P(asin)
-
-/** Inverse cosine (arc cosine). */
-DECLARE_FUNCTION_1P(acos)
-
-/** Inverse tangent (arc tangent). */
-DECLARE_FUNCTION_1P(atan)
-
-/** Inverse tangent with two arguments. */
-DECLARE_FUNCTION_2P(atan2)
-
-/** Hyperbolic Sine. */
-DECLARE_FUNCTION_1P(sinh)
-
-/** Hyperbolic Cosine. */
-DECLARE_FUNCTION_1P(cosh)
-
-/** Hyperbolic Tangent. */
-DECLARE_FUNCTION_1P(tanh)
-
-/** Inverse hyperbolic Sine (area hyperbolic sine). */
-DECLARE_FUNCTION_1P(asinh)
-
-/** Inverse hyperbolic Cosine (area hyperbolic cosine). */
-DECLARE_FUNCTION_1P(acosh)
-
-/** Inverse hyperbolic Tangent (area hyperbolic tangent). */
-DECLARE_FUNCTION_1P(atanh)
-
-/** Dilogarithm. */
-DECLARE_FUNCTION_1P(Li2)
-
-/** Trilogarithm. */
-DECLARE_FUNCTION_1P(Li3)
-
-/** Riemann's Zeta-function. */
-DECLARE_FUNCTION_1P(zeta)
-//DECLARE_FUNCTION_2P(zeta)
+/** Absolute value. */
+class abs_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(abs_function)
+public:
+       virtual ex conjugate() const;
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex power_law(const ex& exp) const;
+protected:
+       void do_print_csrc_float(const print_context& c, unsigned level) const;
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline abs_function abs(const T1& x1) { return abs_function(x1); }
+inline abs_function abs(double x1) { return abs_function(x1); }
+inline abs_function abs(float x1) { return abs_function(x1); }
+
+/** Complex conjugate. */
+GINAC_FUNCTION_1P(conjugate,
+               GINAC_FUNCTION_conjugate
+               GINAC_FUNCTION_eval
+               GINAC_FUNCTION_evalf
+               GINAC_FUNCTION_print_latex)
+
+/** Complex sign. */
+GINAC_FUNCTION_1P(csgn,
+               GINAC_FUNCTION_conjugate
+               GINAC_FUNCTION_eval
+               GINAC_FUNCTION_evalf
+               GINAC_FUNCTION_power_law
+               GINAC_FUNCTION_series)
+
+/** Step function. */
+class step_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(step_function)
+public:
+       virtual ex conjugate() const;
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex series(const relational& r, int order, unsigned options = 0) const;
+};
 
-/** Gamma-function. */
-DECLARE_FUNCTION_1P(gamma)
+template<typename T1> inline step_function step(const T1& x1) { return step_function(x1); }
 
-/** Psi-function (aka polygamma-function). */
-//DECLARE_FUNCTION_1P(psi)
-DECLARE_FUNCTION_2P(psi)
-    
 /** Factorial function. */
-DECLARE_FUNCTION_1P(factorial)
-
-/** Binomial function. */
-DECLARE_FUNCTION_2P(binomial)
+class factorial_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(factorial_function)
+public:
+       virtual ex conjugate() const;
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+protected:
+       void do_print_dflt_latex(const print_context& c, unsigned level) const;
+};
 
-/** Order term function (for truncated power series). */
-DECLARE_FUNCTION_1P(Order)
+template<typename T1> inline factorial_function factorial(const T1& x1) { return factorial_function(x1); }
 
-ex lsolve(ex const &eqns, ex const &symbols);
+/** Binomial function. */
+class binomial_function : public function
+{
+       GINAC_DECLARE_FUNCTION_2P(binomial_function)
+public:
+       virtual ex conjugate() const;
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+protected:
+       ex sym(const ex& x, const numeric& y) const;
+};
 
-ex ncpower(ex const &basis, unsigned exponent);
+template<typename T1, typename T2> inline binomial_function binomial(const T1& x1, const T2& x2) { return binomial_function(x1, x2); }
 
-inline bool is_order_function(ex const & e)
+/** Order term function (for truncated power series). */
+class Order_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(Order_function)
+public:
+       virtual ex conjugate() const;
+       virtual ex derivative(const symbol& s) const;
+       virtual ex eval(int level = 0) const;
+       virtual ex series(const relational& r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline Order_function Order(const T1& x1) { return Order_function(x1); }
+
+/** Abstract derivative of functions. */
+class function_derivative_function : public function
 {
-       return is_ex_the_function(e, Order);
-}
+       GINAC_DECLARE_FUNCTION_2P(function_derivative_function)
+public:
+       virtual ex derivative(const symbol& s) const;
+       virtual ex eval(int level = 0) const;
+protected:
+       void do_print_dflt(const print_context& c, unsigned level) const;
+       void do_print_tree(const print_tree& c, unsigned level) const;
+};
+
+template<typename T1, typename T2>
+inline function_derivative_function function_derivative(const T1& x1, const T2& x2) { return function_derivative_function(x1, x2); }
+
+ex lsolve(const ex& eqns, const ex& symbols, unsigned options = solve_algo::automatic);
+
+/** Find a real root of real-valued function f(x) numerically within a given
+ *  interval. The function must change sign across interval. Uses Newton-
+ *  Raphson method combined with bisection in order to guarantee convergence.
+ *
+ *  @param f  Function f(x)
+ *  @param x  Symbol f(x)
+ *  @param x1  lower interval limit
+ *  @param x2  upper interval limit
+ *  @exception runtime_error (if interval is invalid). */
+const numeric fsolve(const ex& f, const symbol& x, const numeric& x1, const numeric& x2);
 
 } // namespace GiNaC
 
diff --git a/ginac/inifcns_exp.cpp b/ginac/inifcns_exp.cpp
new file mode 100644 (file)
index 0000000..a464400
--- /dev/null
@@ -0,0 +1,903 @@
+/** @file inifcns_exp.cpp
+ *
+ *  Implementation of TODO
+ *  functions. */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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 "inifcns_exp.h"
+
+#include <vector>
+#include <stdexcept>
+
+#include "inifcns.h"
+#include "inifcns_polylog.h"
+#include "ex.h"
+#include "constant.h"
+#include "numeric.h"
+#include "power.h"
+#include "operators.h"
+#include "relational.h"
+#include "symbol.h"
+#include "symmetry.h"
+#include "pseries.h"
+#include "utils.h"
+
+namespace GiNaC {
+
+GINAC_IMPLEMENT_FUNCTION_OPT(eta_function,
+               print_func<print_latex>(&eta_function::do_print_latex))
+
+ex eta_function::conjugate() const
+{
+       return -eta(seq[0], seq[1]);
+}
+
+ex eta_function::eval(int level) const
+{
+       // Canonicalize argument order according to the symmetry properties
+       exvector v = seq;
+       int sig = canonicalize(v.begin(), sy_symm(0,1));
+       if (sig != INT_MAX) {
+               // Something has changed while sorting arguments, more evaluations later
+               if (sig == 0) {
+                       return _ex0;
+               }
+               return ex(sig) * thiscontainer(v);
+       }
+
+       const ex& x = seq[0];
+       const ex& y = seq[1];
+       // 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<numeric>(x);
+               const numeric ny = ex_to<numeric>(y);
+               const numeric nxy = ex_to<numeric>(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 this->hold();
+}
+
+ex eta_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       const ex& y = seq[1];
+       // 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<numeric>(x);
+               const numeric ny = ex_to<numeric>(y);
+               const numeric nxy = ex_to<numeric>(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 GiNaC::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 this->hold();
+}
+
+ex eta_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& x = seq[0];
+       const ex& y = seq[1];
+       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);
+}
+
+void eta_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\eta";
+       inherited::do_print(c,level);
+}
+
+//////////
+// exponential function
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(exp_function,
+               print_func<print_csrc_float>(&exp_function::do_print_csrc_float).
+               print_func<print_latex>(&exp_function::do_print_latex))
+
+ex exp_function::eval(int level) const
+{
+       const ex& x = seq[0];
+
+       // exp(0) -> 1
+       if (x.is_zero()) {
+               return _ex1;
+       }
+
+       // exp(n*Pi*I/2) -> {+1|+I|-1|-I}
+       const ex TwoExOverPiI=(_ex2*x)/(Pi*I);
+       if (TwoExOverPiI.info(info_flags::integer)) {
+               const numeric z = mod(ex_to<numeric>(TwoExOverPiI),*_num4_p);
+               if (z.is_equal(*_num0_p))
+                       return _ex1;
+               if (z.is_equal(*_num1_p))
+                       return ex(I);
+               if (z.is_equal(*_num2_p))
+                       return _ex_1;
+               if (z.is_equal(*_num3_p))
+                       return ex(-I);
+       }
+
+       // exp(log(x)) -> x
+       if (is_exactly_a<log_function>(x))
+               return x.op(0);
+       
+       // exp(float) -> float
+       if (x.info(info_flags::numeric) && !x.info(info_flags::crational))
+               return exp(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex exp_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x))
+               return exp(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex exp_function::pderivative(unsigned deriv_param) const
+{
+       GINAC_ASSERT(deriv_param==0);
+
+       // d/dx exp(x) -> exp(x)
+       return *this;
+}
+
+void exp_function::do_print_csrc_float(const print_context& c, unsigned level) const
+{
+       c.s << "exp("; seq[0].print(c); c.s << ")";
+}
+
+void exp_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\exp";
+       inherited::do_print(c,level);
+}
+
+//////////
+// natural logarithm
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(log_function,
+               print_func<print_csrc_float>(&log_function::do_print_csrc_float).
+               print_func<print_latex>(&log_function::do_print_latex))
+
+ex log_function::eval(int level) const
+{
+       const ex& x = seq[0];
+       if (x.info(info_flags::numeric)) {
+               if (x.is_zero())         // log(0) -> infinity
+                       throw(pole_error("log_eval(): log(0)",0));
+               if (x.info(info_flags::rational) && x.info(info_flags::negative))
+                       return (log(-x)+I*Pi);
+               if (x.is_equal(_ex1))  // log(1) -> 0
+                       return _ex0;
+               if (x.is_equal(I))       // log(I) -> Pi*I/2
+                       return (Pi*I*_ex1_2);
+               if (x.is_equal(-I))      // log(-I) -> -Pi*I/2
+                       return (Pi*I*_ex_1_2);
+
+               // log(float) -> float
+               if (!x.info(info_flags::crational))
+                       return log(ex_to<numeric>(x));
+       }
+
+       // log(exp(t)) -> t (if -Pi < t.imag() <= Pi):
+       if (is_exactly_a<exp_function>(x)) {
+               const ex& t = x.op(0);
+               if (t.info(info_flags::real)) {
+                       return t;
+               }
+       }
+       
+       return this->hold();
+}
+
+ex log_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x))
+               return log(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex log_function::pderivative(unsigned deriv_param) const
+{
+       const ex& x = seq[0];
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx log(x) -> 1/x
+       return power::power(x, _ex_1);
+}
+
+ex log_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& arg = seq[0];
+
+       GINAC_ASSERT(is_a<symbol>(rel.lhs()));
+       ex arg_pt;
+       bool must_expand_arg = false;
+       // maybe substitution of rel into arg fails because of a pole
+       try {
+               arg_pt = arg.subs(rel, subs_options::no_pattern);
+       } catch (pole_error) {
+               must_expand_arg = true;
+       }
+       // or we are at the branch point anyways
+       if (arg_pt.is_zero())
+               must_expand_arg = true;
+       
+       if (must_expand_arg) {
+               // method:
+               // This is the branch point: Series expand the argument first, then
+               // trivially factorize it to isolate that part which has constant
+               // leading coefficient in this fashion:
+               //   x^n + x^(n+1) +...+ Order(x^(n+m))  ->  x^n * (1 + x +...+ Order(x^m)).
+               // Return a plain n*log(x) for the x^n part and series expand the
+               // other part.  Add them together and reexpand again in order to have
+               // one unnested pseries object.  All this also works for negative n.
+               pseries argser;          // series expansion of log's argument
+               unsigned extra_ord = 0;  // extra expansion order
+               do {
+                       // oops, the argument expanded to a pure Order(x^something)...
+                       argser = ex_to<pseries>(arg.series(rel, order+extra_ord, options));
+                       ++extra_ord;
+               } while (!argser.is_terminating() && argser.nops()==1);
+
+               const symbol &s = ex_to<symbol>(rel.lhs());
+               const ex &point = rel.rhs();
+               const int n = argser.ldegree(s);
+               epvector seq;
+               // construct what we carelessly called the n*log(x) term above
+               const ex coeff = argser.coeff(s, n);
+               // expand the log, but only if coeff is real and > 0, since otherwise
+               // it would make the branch cut run into the wrong direction
+               if (coeff.info(info_flags::positive))
+                       seq.push_back(expair(n*log(s-point)+log(coeff), _ex0));
+               else
+                       seq.push_back(expair(log(coeff*pow(s-point, n)), _ex0));
+
+               if (!argser.is_terminating() || argser.nops()!=1) {
+                       // in this case n more (or less) terms are needed
+                       // (sadly, to generate them, we have to start from the beginning)
+                       if (n == 0 && coeff == 1) {
+                               epvector epv;
+                               ex acc = (new pseries(rel, epv))->setflag(status_flags::dynallocated);
+                               epv.reserve(2);
+                               epv.push_back(expair(-1, _ex0));
+                               epv.push_back(expair(Order(_ex1), order));
+                               ex rest = pseries(rel, epv).add_series(argser);
+                               for (int i = order-1; i>0; --i) {
+                                       epvector cterm;
+                                       cterm.reserve(1);
+                                       cterm.push_back(expair(i%2 ? _ex1/i : _ex_1/i, _ex0));
+                                       acc = pseries(rel, cterm).add_series(ex_to<pseries>(acc));
+                                       acc = (ex_to<pseries>(rest)).mul_series(ex_to<pseries>(acc));
+                               }
+                               return acc;
+                       }
+                       const ex newarg = ex_to<pseries>((arg/coeff).series(rel, order+n, options)).shift_exponents(-n).convert_to_poly(true);
+                       return pseries(rel, seq).add_series(ex_to<pseries>(log(newarg).series(rel, order, options)));
+               } else  // it was a monomial
+                       return pseries(rel, seq);
+       }
+       if (!(options & series_options::suppress_branchcut) &&
+            arg_pt.info(info_flags::negative)) {
+               // method:
+               // This is the branch cut: assemble the primitive series manually and
+               // then add the corresponding complex step function.
+               const symbol &s = ex_to<symbol>(rel.lhs());
+               const ex &point = rel.rhs();
+               const symbol foo;
+               const ex replarg = log(arg).series(s==foo, order).subs(foo==point, subs_options::no_pattern);
+               epvector seq;
+               seq.push_back(expair(-I*csgn(arg*I)*Pi, _ex0));
+               seq.push_back(expair(Order(_ex1), order));
+               return (replarg - I*Pi + pseries(rel, seq)).series(rel, order);
+       }
+       return basic::series(rel, order, options);
+}
+
+void log_function::do_print_csrc_float(const print_context& c, unsigned level) const
+{
+       c.s << "log("; seq[0].print(c); c.s << ")";
+}
+
+void log_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\log";
+       inherited::do_print(c,level);
+}
+
+//////////
+// Logarithm of Gamma function
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(lgamma_function,
+               print_func<print_latex>(&lgamma_function::do_print_latex))
+
+/** Evaluation of lgamma(x), the natural logarithm of the Gamma function.
+ *  Knows about integer arguments and that's it.  Somebody ought to provide
+ *  some good numerical evaluation some day...
+ *
+ *  @exception GiNaC::pole_error("lgamma_eval(): logarithmic pole",0) */
+ex lgamma_function::eval(int level) const
+{
+       const ex& x = seq[0];
+       if (x.info(info_flags::numeric)) {
+               // trap integer arguments:
+               if (x.info(info_flags::integer)) {
+                       // lgamma(n) -> log((n-1)!) for postitive n
+                       if (x.info(info_flags::posint))
+                               return log(factorial(x + _ex_1));
+                       else
+                               throw (pole_error("lgamma_eval(): logarithmic pole",0));
+               }
+               //  lgamma_evalf should be called here once it becomes available
+       }
+       
+       return this->hold();
+}
+
+ex lgamma_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x)) {
+               try {
+                       return lgamma(ex_to<numeric>(x));
+               } catch (const dunno& e) { }
+       }
+       
+       return this->hold();
+}
+
+ex lgamma_function::pderivative(unsigned deriv_param) const
+{
+       const ex& x = seq[0];
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx  lgamma(x) -> psi(x)
+       return psi(x);
+}
+
+ex lgamma_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& arg = seq[0];
+       // method:
+       // Taylor series where there is no pole falls back to psi function
+       // evaluation.
+       // On a pole at -m we could use the recurrence relation
+       //   lgamma(x) == lgamma(x+1)-log(x)
+       // from which follows
+       //   series(lgamma(x),x==-m,order) ==
+       //   series(lgamma(x+m+1)-log(x)...-log(x+m)),x==-m,order);
+       const ex arg_pt = arg.subs(rel, subs_options::no_pattern);
+       if (!arg_pt.info(info_flags::integer) || arg_pt.info(info_flags::positive))
+               return basic::series(rel, order, options);
+       // if we got here we have to care for a simple pole of tgamma(-m):
+       numeric m = -ex_to<numeric>(arg_pt);
+       ex recur;
+       for (numeric p = 0; p<=m; ++p)
+               recur += log(arg+p);
+       return (lgamma(arg+m+_ex1)-recur).series(rel, order, options);
+}
+
+void lgamma_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\log \\Gamma";
+       inherited::do_print(c,level);
+}
+
+//////////
+// true Gamma function
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(tgamma_function,
+               print_func<print_latex>(&tgamma_function::do_print_latex))
+
+/** Evaluation of tgamma(x), the true Gamma function.  Knows about integer
+ *  arguments, half-integer arguments and that's it. Somebody ought to provide
+ *  some good numerical evaluation some day...
+ *
+ *  @exception pole_error("tgamma_eval(): simple pole",0) */
+ex tgamma_function::eval(int level) const
+{
+       const ex& x = seq[0];
+       if (x.info(info_flags::numeric)) {
+               // trap integer arguments:
+               const numeric two_x = (*_num2_p)*ex_to<numeric>(x);
+               if (two_x.is_even()) {
+                       // tgamma(n) -> (n-1)! for postitive n
+                       if (two_x.is_positive()) {
+                               return factorial(ex_to<numeric>(x).sub(*_num1_p));
+                       } else {
+                               throw (pole_error("tgamma_eval(): simple pole",1));
+                       }
+               }
+               // trap half integer arguments:
+               if (two_x.is_integer()) {
+                       // trap positive x==(n+1/2)
+                       // tgamma(n+1/2) -> Pi^(1/2)*(1*3*..*(2*n-1))/(2^n)
+                       if (two_x.is_positive()) {
+                               const numeric n = ex_to<numeric>(x).sub(*_num1_2_p);
+                               return (doublefactorial(n.mul(*_num2_p).sub(*_num1_p)).div(pow(*_num2_p,n))) * sqrt(Pi);
+                       } else {
+                               // trap negative x==(-n+1/2)
+                               // tgamma(-n+1/2) -> Pi^(1/2)*(-2)^n/(1*3*..*(2*n-1))
+                               const numeric n = abs(ex_to<numeric>(x).sub(*_num1_2_p));
+                               return (pow(*_num_2_p, n).div(doublefactorial(n.mul(*_num2_p).sub(*_num1_p))))*sqrt(Pi);
+                       }
+               }
+               //  tgamma_evalf should be called here once it becomes available
+       }
+       
+       return this->hold();
+}
+
+ex tgamma_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x)) {
+               try {
+                       return tgamma(ex_to<numeric>(x));
+               } catch (const dunno &e) { }
+       }
+       
+       return this->hold();
+}
+
+ex tgamma_function::pderivative(unsigned deriv_param) const
+{
+       const ex& x = seq[0];
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx  tgamma(x) -> psi(x)*tgamma(x)
+       return psi(x)*tgamma(x);
+}
+
+ex tgamma_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& arg = seq[0];
+       // method:
+       // Taylor series where there is no pole falls back to psi function
+       // evaluation.
+       // On a pole at -m use the recurrence relation
+       //   tgamma(x) == tgamma(x+1) / x
+       // from which follows
+       //   series(tgamma(x),x==-m,order) ==
+       //   series(tgamma(x+m+1)/(x*(x+1)*...*(x+m)),x==-m,order);
+       const ex arg_pt = arg.subs(rel, subs_options::no_pattern);
+       if (!arg_pt.info(info_flags::integer) || arg_pt.info(info_flags::positive)) {
+               return basic::series(rel, order, options);
+       }
+       // if we got here we have to care for a simple pole at -m:
+       const numeric m = -ex_to<numeric>(arg_pt);
+       ex ser_denom = _ex1;
+       for (numeric p; p<=m; ++p)
+               ser_denom *= arg+p;
+       return (tgamma(arg+m+_ex1)/ser_denom).series(rel, order, options);
+}
+
+void tgamma_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\Gamma";
+       inherited::do_print(c,level);
+}
+
+//////////
+// beta-function
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(beta_function,
+               print_func<print_latex>(&beta_function::do_print_latex))
+
+ex beta_function::eval(int level) const
+{
+       // Canonicalize argument order according to the symmetry properties
+       exvector v = seq;
+       int sig = canonicalize(v.begin(), sy_symm(0,1));
+       if (sig != INT_MAX) {
+               // Something has changed while sorting arguments, more evaluations later
+               if (sig == 0) {
+                       return _ex0;
+               }
+               return ex(sig) * thiscontainer(v);
+       }
+
+       const ex& x = seq[0];
+       const ex& y = seq[1];
+       if (x.is_equal(_ex1))
+               return 1/y;
+       if (y.is_equal(_ex1))
+               return 1/x;
+       if (x.info(info_flags::numeric) && y.info(info_flags::numeric)) {
+               // treat all problematic x and y that may not be passed into tgamma,
+               // because they would throw there although beta(x,y) is well-defined
+               // using the formula beta(x,y) == (-1)^y * beta(1-x-y, y)
+               const numeric &nx = ex_to<numeric>(x);
+               const numeric &ny = ex_to<numeric>(y);
+               if (nx.is_real() && nx.is_integer() &&
+                       ny.is_real() && ny.is_integer()) {
+                       if (nx.is_negative()) {
+                               if (nx<=-ny)
+                                       return pow(*_num_1_p, ny)*beta(1-x-y, y);
+                               else
+                                       throw (pole_error("beta_eval(): simple pole",1));
+                       }
+                       if (ny.is_negative()) {
+                               if (ny<=-nx)
+                                       return pow(*_num_1_p, nx)*beta(1-y-x, x);
+                               else
+                                       throw (pole_error("beta_eval(): simple pole",1));
+                       }
+                       return tgamma(x)*tgamma(y)/tgamma(x+y);
+               }
+               // no problem in numerator, but denominator has pole:
+               if ((nx+ny).is_real() &&
+                   (nx+ny).is_integer() &&
+                  !(nx+ny).is_positive())
+                        return _ex0;
+               // beta_evalf should be called here once it becomes available
+       }
+       
+       return this->hold();
+}
+
+ex beta_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       const ex& y = seq[1];
+       if (is_exactly_a<numeric>(x) && is_exactly_a<numeric>(y)) {
+               try {
+                       return tgamma(ex_to<numeric>(x))*tgamma(ex_to<numeric>(y))/tgamma(ex_to<numeric>(x+y));
+               } catch (const dunno &e) { }
+       }
+       
+       return this->hold();
+}
+
+ex beta_function::pderivative(unsigned deriv_param) const
+
+{
+       const ex& x = seq[0];
+       const ex& y = seq[1];
+       GINAC_ASSERT(deriv_param<2);
+       ex retval;
+       
+       // d/dx beta(x,y) -> (psi(x)-psi(x+y)) * beta(x,y)
+       if (deriv_param==0)
+               retval = (psi(x)-psi(x+y))*beta(x,y);
+       // d/dy beta(x,y) -> (psi(y)-psi(x+y)) * beta(x,y)
+       if (deriv_param==1)
+               retval = (psi(y)-psi(x+y))*beta(x,y);
+       return retval;
+}
+
+ex beta_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& arg1 = seq[0];
+       const ex& arg2 = seq[1];
+       // method:
+       // Taylor series where there is no pole of one of the tgamma functions
+       // falls back to beta function evaluation.  Otherwise, fall back to
+       // tgamma series directly.
+       const ex arg1_pt = arg1.subs(rel, subs_options::no_pattern);
+       const ex arg2_pt = arg2.subs(rel, subs_options::no_pattern);
+       GINAC_ASSERT(is_a<symbol>(rel.lhs()));
+       const symbol &s = ex_to<symbol>(rel.lhs());
+       ex arg1_ser, arg2_ser, arg1arg2_ser;
+       if ((!arg1_pt.info(info_flags::integer) || arg1_pt.info(info_flags::positive)) &&
+           (!arg2_pt.info(info_flags::integer) || arg2_pt.info(info_flags::positive)))
+               return basic::series(rel, order, options);
+       // trap the case where arg1 is on a pole:
+       if (arg1.info(info_flags::integer) && !arg1.info(info_flags::positive))
+               arg1_ser = tgamma(arg1+s);
+       else
+               arg1_ser = tgamma(arg1);
+       // trap the case where arg2 is on a pole:
+       if (arg2.info(info_flags::integer) && !arg2.info(info_flags::positive))
+               arg2_ser = tgamma(arg2+s);
+       else
+               arg2_ser = tgamma(arg2);
+       // trap the case where arg1+arg2 is on a pole:
+       if ((arg1+arg2).info(info_flags::integer) && !(arg1+arg2).info(info_flags::positive))
+               arg1arg2_ser = tgamma(arg2+arg1+s);
+       else
+               arg1arg2_ser = tgamma(arg2+arg1);
+       // compose the result (expanding all the terms):
+       return (arg1_ser*arg2_ser/arg1arg2_ser).series(rel, order, options).expand();
+}
+
+void beta_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\mbox{B}";
+       inherited::do_print(c,level);
+}
+
+//////////
+// Psi-function (aka digamma-function)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(psi1_function,
+               print_func<print_latex>(&psi1_function::do_print_latex))
+
+/** Evaluation of digamma-function psi(x).
+ *  Somebody ought to provide some good numerical evaluation some day... */
+ex psi1_function::eval(int level) const
+{
+       const ex& x = seq[0];
+       if (x.info(info_flags::numeric)) {
+               const numeric &nx = ex_to<numeric>(x);
+               if (nx.is_integer()) {
+                       // integer case 
+                       if (nx.is_positive()) {
+                               // psi(n) -> 1 + 1/2 +...+ 1/(n-1) - Euler
+                               numeric rat = 0;
+                               for (numeric i(nx+(*_num_1_p)); i>0; --i)
+                                       rat += i.inverse();
+                               return rat-Euler;
+                       } else {
+                               // for non-positive integers there is a pole:
+                               throw (pole_error("psi_eval(): simple pole",1));
+                       }
+               }
+               if (((*_num2_p)*nx).is_integer()) {
+                       // half integer case
+                       if (nx.is_positive()) {
+                               // psi((2m+1)/2) -> 2/(2m+1) + 2/2m +...+ 2/1 - Euler - 2log(2)
+                               numeric rat = 0;
+                               for (numeric i = (nx+(*_num_1_p))*(*_num2_p); i>0; i-=(*_num2_p))
+                                       rat += (*_num2_p)*i.inverse();
+                               return rat-Euler-_ex2*log(_ex2);
+                       } else {
+                               // use the recurrence relation
+                               //   psi(-m-1/2) == psi(-m-1/2+1) - 1 / (-m-1/2)
+                               // to relate psi(-m-1/2) to psi(1/2):
+                               //   psi(-m-1/2) == psi(1/2) + r
+                               // where r == ((-1/2)^(-1) + ... + (-m-1/2)^(-1))
+                               numeric recur = 0;
+                               for (numeric p = nx; p<0; ++p)
+                                       recur -= pow(p, *_num_1_p);
+                               return recur+psi(_ex1_2);
+                       }
+               }
+               //  psi1_evalf should be called here once it becomes available
+       }
+       
+       return this->hold();
+}
+
+ex psi1_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x)) {
+               try {
+                       return psi(ex_to<numeric>(x));
+               } catch (const dunno &e) { }
+       }
+       
+       return this->hold();
+}
+
+ex psi1_function::pderivative(unsigned deriv_param) const
+{
+       const ex& x = seq[0];
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx psi(x) -> psi(1,x)
+       return psi(_ex1, x);
+}
+
+ex psi1_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& arg = seq[0];
+       // method:
+       // Taylor series where there is no pole falls back to polygamma function
+       // evaluation.
+       // On a pole at -m use the recurrence relation
+       //   psi(x) == psi(x+1) - 1/z
+       // from which follows
+       //   series(psi(x),x==-m,order) ==
+       //   series(psi(x+m+1) - 1/x - 1/(x+1) - 1/(x+m)),x==-m,order);
+       const ex arg_pt = arg.subs(rel, subs_options::no_pattern);
+       if (!arg_pt.info(info_flags::integer) || arg_pt.info(info_flags::positive))
+               return basic::series(rel, order, options);
+       // if we got here we have to care for a simple pole at -m:
+       const numeric m = -ex_to<numeric>(arg_pt);
+       ex recur;
+       for (numeric p; p<=m; ++p)
+               recur += power::power(arg+p,_ex_1);
+       return (psi(arg+m+_ex1)-recur).series(rel, order, options);
+}
+
+void psi1_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\psi";
+       inherited::do_print(c,level);
+}
+
+//////////
+// Psi-functions (aka polygamma-functions)  psi(0,x)==psi(x)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(psi2_function,
+               print_func<print_latex>(&psi2_function::do_print_latex))
+
+/** Evaluation of polygamma-function psi(n,x). 
+ *  Somebody ought to provide some good numerical evaluation some day... */
+ex psi2_function::eval(int eval) const
+{
+       const ex& n = seq[0];
+       const ex& x = seq[1];
+       // psi(0,x) -> psi(x)
+       if (n.is_zero())
+               return psi(x);
+       // psi(-1,x) -> log(tgamma(x))
+       if (n.is_equal(_ex_1))
+               return log(tgamma(x));
+       if (n.info(info_flags::numeric) && n.info(info_flags::posint) &&
+               x.info(info_flags::numeric)) {
+               const numeric &nn = ex_to<numeric>(n);
+               const numeric &nx = ex_to<numeric>(x);
+               if (nx.is_integer()) {
+                       // integer case 
+                       if (nx.is_equal(*_num1_p))
+                               // use psi(n,1) == (-)^(n+1) * n! * zeta(n+1)
+                               return pow(*_num_1_p,nn+(*_num1_p))*factorial(nn)*zeta_function(nn+(*_num1_p));
+                       if (nx.is_positive()) {
+                               // use the recurrence relation
+                               //   psi(n,m) == psi(n,m+1) - (-)^n * n! / m^(n+1)
+                               // to relate psi(n,m) to psi(n,1):
+                               //   psi(n,m) == psi(n,1) + r
+                               // where r == (-)^n * n! * (1^(-n-1) + ... + (m-1)^(-n-1))
+                               numeric recur = 0;
+                               for (numeric p = 1; p<nx; ++p)
+                                       recur += pow(p, -nn+(*_num_1_p));
+                               recur *= factorial(nn)*pow((*_num_1_p), nn);
+                               return recur+psi(n,_ex1);
+                       } else {
+                               // for non-positive integers there is a pole:
+                               throw (pole_error("psi2_eval(): pole",1));
+                       }
+               }
+               if (((*_num2_p)*nx).is_integer()) {
+                       // half integer case
+                       if (nx.is_equal(*_num1_2_p))
+                               // use psi(n,1/2) == (-)^(n+1) * n! * (2^(n+1)-1) * zeta(n+1)
+                               return pow(*_num_1_p,nn+(*_num1_p))*factorial(nn)*(pow(*_num2_p,nn+(*_num1_p)) + (*_num_1_p))*zeta_function(nn+(*_num1_p));
+                       if (nx.is_positive()) {
+                               const numeric m = nx - (*_num1_2_p);
+                               // use the multiplication formula
+                               //   psi(n,2*m) == (psi(n,m) + psi(n,m+1/2)) / 2^(n+1)
+                               // to revert to positive integer case
+                               return psi(n,(*_num2_p)*m)*pow((*_num2_p),nn+(*_num1_p))-psi(n,m);
+                       } else {
+                               // use the recurrence relation
+                               //   psi(n,-m-1/2) == psi(n,-m-1/2+1) - (-)^n * n! / (-m-1/2)^(n+1)
+                               // to relate psi(n,-m-1/2) to psi(n,1/2):
+                               //   psi(n,-m-1/2) == psi(n,1/2) + r
+                               // where r == (-)^(n+1) * n! * ((-1/2)^(-n-1) + ... + (-m-1/2)^(-n-1))
+                               numeric recur = 0;
+                               for (numeric p = nx; p<0; ++p)
+                                       recur += pow(p, -nn+(*_num_1_p));
+                               recur *= factorial(nn)*pow(*_num_1_p, nn+(*_num_1_p));
+                               return recur+psi(n,_ex1_2);
+                       }
+               }
+               //  psi2_evalf should be called here once it becomes available
+       }
+       
+       return this->hold();
+}    
+
+ex psi2_function::evalf(int eval) const
+{
+       const ex& n = seq[0];
+       const ex& x = seq[1];
+       if (is_exactly_a<numeric>(n) && is_exactly_a<numeric>(x)) {
+               try {
+                       return psi(ex_to<numeric>(n),ex_to<numeric>(x));
+               } catch (const dunno &e) { }
+       }
+       
+       return this->hold();
+}
+
+ex psi2_function::pderivative(unsigned deriv_param) const
+{
+       const ex& n = seq[0];
+       const ex& x = seq[1];
+       GINAC_ASSERT(deriv_param<2);
+       
+       if (deriv_param==0) {
+               // d/dn psi(n,x)
+               throw(std::logic_error("cannot diff psi(n,x) with respect to n"));
+       }
+       // d/dx psi(n,x) -> psi(n+1,x)
+       return psi(n+_ex1, x);
+}
+
+ex psi2_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& n = seq[0];
+       const ex& arg = seq[1];
+       // method:
+       // Taylor series where there is no pole falls back to polygamma function
+       // evaluation.
+       // On a pole at -m use the recurrence relation
+       //   psi(n,x) == psi(n,x+1) - (-)^n * n! / x^(n+1)
+       // from which follows
+       //   series(psi(x),x==-m,order) == 
+       //   series(psi(x+m+1) - (-1)^n * n! * ((x)^(-n-1) + (x+1)^(-n-1) + ...
+       //                                      ... + (x+m)^(-n-1))),x==-m,order);
+       const ex arg_pt = arg.subs(rel, subs_options::no_pattern);
+       if (!arg_pt.info(info_flags::integer) || arg_pt.info(info_flags::positive))
+               return basic::series(rel, order, options);
+       // if we got here we have to care for a pole of order n+1 at -m:
+       const numeric m = -ex_to<numeric>(arg_pt);
+       ex recur;
+       for (numeric p; p<=m; ++p)
+               recur += power(arg+p,-n+_ex_1);
+       recur *= factorial(n)*power(_ex_1,n);
+       return (psi(n, arg+m+_ex1)-recur).series(rel, order, options);
+}
+
+void psi2_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\psi";
+       inherited::do_print(c,level);
+}
+
+} // namespace GiNaC
diff --git a/ginac/inifcns_exp.h b/ginac/inifcns_exp.h
new file mode 100644 (file)
index 0000000..b52646d
--- /dev/null
@@ -0,0 +1,164 @@
+/** @file inifcns_exp.h
+ *
+ *  Interface to GiNaC's TODO */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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
+ */
+
+#ifndef __GINAC_INIFCNS_EXP_H__
+#define __GINAC_INIFCNS_EXP_H__
+
+#include "numeric.h"
+#include "function.h"
+#include "ex.h"
+
+namespace GiNaC {
+
+/** Eta function: log(a*b) == log(a) + log(b) + eta(a, b). */
+//////////
+// 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).
+//////////
+class eta_function : public function
+{
+       GINAC_DECLARE_FUNCTION_2P(eta_function)
+public:
+       virtual ex conjugate() const;
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex series(const relational& r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1, typename T2> inline eta_function eta(const T1& x1, const T2& x2) { return eta_function(x1, x2); }
+
+/** Exponential function. */
+class exp_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(exp_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned deriv_param) const;
+protected:
+       void do_print_csrc_float(const print_context& c, unsigned level) const;
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline exp_function exp(const T1& x1) { return exp_function(x1); }
+inline exp_function exp(double x1) { return exp_function(x1); }
+inline exp_function exp(float x1) { return exp_function(x1); }
+
+/** Natural logarithm. */
+class log_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(log_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned deriv_param) const;
+       virtual ex series(const relational& r, int order, unsigned options = 0) const;
+protected:
+       void do_print_csrc_float(const print_context& c, unsigned level) const;
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline log_function log(const T1& x1) { return log_function(x1); }
+inline log_function log(double x1) { return log_function(x1); }
+inline log_function log(float x1) { return log_function(x1); }
+
+/** Log-Gamma-function. */
+class lgamma_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(lgamma_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned deriv_param) const;
+       virtual ex series(const relational& r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline lgamma_function lgamma(const T1& x1) { return lgamma_function(x1); }
+
+/** Gamma-function. */
+class tgamma_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(tgamma_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned deriv_param) const;
+       virtual ex series(const relational& r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline tgamma_function tgamma(const T1& x1) { return tgamma_function(x1); }
+
+/** Beta-function. */
+class beta_function : public function
+{
+       GINAC_DECLARE_FUNCTION_2P(beta_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned deriv_param) const;
+       virtual ex series(const relational& r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1, typename T2> inline beta_function beta(const T1& x1, const T2& x2) { return beta_function(x1, x2); }
+
+/** Psi-function (aka digamma-function). */
+class psi1_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(psi1_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned deriv_param) const;
+       virtual ex series(const relational& r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline psi1_function psi(const T1& x1) { return psi1_function(x1); }
+
+/** Derivatives of Psi-function (aka polygamma-functions). */
+class psi2_function : public function
+{
+       GINAC_DECLARE_FUNCTION_2P(psi2_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned deriv_param) const;
+       virtual ex series(const relational& r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1, typename T2> inline psi2_function psi(const T1& x1, const T2& x2) { return psi2_function(x1, x2); }
+
+} // namespace GiNaC
+
+#endif // ndef __GINAC_INIFCNS_EXP_H__
diff --git a/ginac/inifcns_gamma.cpp b/ginac/inifcns_gamma.cpp
deleted file mode 100644 (file)
index bb3a74e..0000000
+++ /dev/null
@@ -1,145 +0,0 @@
-/** @file inifcns_gamma.cpp
- *
- *  Implementation of Gamma-function, Polygamma-functions, and some related
- *  stuff. */
-
-/*
- *  GiNaC Copyright (C) 1999 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
- */
-
-#include <vector>
-#include <stdexcept>
-
-#include "inifcns.h"
-#include "ex.h"
-#include "constant.h"
-#include "numeric.h"
-#include "power.h"
-#include "symbol.h"
-
-namespace GiNaC {
-
-//////////
-// Gamma-function
-//////////
-
-/** Evaluation of gamma(x). Knows about integer arguments, half-integer
- *  arguments and that's it. Somebody ought to provide some good numerical
- *  evaluation some day...
- *
- *  @exception fail_numeric("complex_infinity") or something similar... */
-static ex gamma_eval(ex const & x)
-{
-    if (x.info(info_flags::numeric)) {
-        // trap integer arguments:
-        if ( x.info(info_flags::integer) ) {
-            // gamma(n+1) -> n! for postitive n
-            if ( x.info(info_flags::posint) ) {
-                return factorial(ex_to_numeric(x).sub(numONE()));
-            } else {
-                return numZERO();  // Infinity. Throw? What?
-            }
-        }
-        // trap half integer arguments:
-        if ( (x*2).info(info_flags::integer) ) {
-            // trap positive x=(n+1/2)
-            // gamma(n+1/2) -> Pi^(1/2)*(1*3*..*(2*n-1))/(2^n)
-            if ( (x*2).info(info_flags::posint) ) {
-                numeric n = ex_to_numeric(x).sub(numHALF());
-                numeric coefficient = doublefactorial(n.mul(numTWO()).sub(numONE()));
-                coefficient = coefficient.div(numTWO().power(n));
-                return coefficient * pow(Pi,numHALF());
-            } else {
-                // trap negative x=(-n+1/2)
-                // gamma(-n+1/2) -> Pi^(1/2)*(-2)^n/(1*3*..*(2*n-1))
-                numeric n = abs(ex_to_numeric(x).sub(numHALF()));
-                numeric coefficient = numeric(-2).power(n);
-                coefficient = coefficient.div(doublefactorial(n.mul(numTWO()).sub(numONE())));;
-                return coefficient*sqrt(Pi);
-            }
-        }
-    }
-    return gamma(x).hold();
-}    
-    
-static ex gamma_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-        TYPECHECK(x,numeric)
-    END_TYPECHECK(gamma(x))
-    
-    return gamma(ex_to_numeric(x));
-}
-
-static ex gamma_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-    
-    return psi(exZERO(),x)*gamma(x);  // diff(log(gamma(x)),x)==psi(0,x)
-}
-
-static ex gamma_series(ex const & x, symbol const & s, ex const & point, int order)
-{
-       // FIXME: Only handle one special case for now...
-       if (x.is_equal(s) && point.is_zero()) {
-               ex e = 1 / s - EulerGamma + s * (pow(Pi, 2) / 12 + pow(EulerGamma, 2) / 2) + Order(pow(s, 2));
-               return e.series(s, point, order);
-       } else
-               throw(std::logic_error("don't know the series expansion of this particular gamma function"));
-}
-
-REGISTER_FUNCTION(gamma, gamma_eval, gamma_evalf, gamma_diff, gamma_series);
-
-//////////
-// Psi-function (aka polygamma-function)
-//////////
-
-/** Evaluation of polygamma-function psi(n,x). 
- *  Somebody ought to provide some good numerical evaluation some day... */
-static ex psi_eval(ex const & n, ex const & x)
-{
-    if (n.info(info_flags::numeric) && x.info(info_flags::numeric)) {
-        // do some stuff...
-    }
-    return psi(n, x).hold();
-}    
-    
-static ex psi_evalf(ex const & n, ex const & x)
-{
-    BEGIN_TYPECHECK
-        TYPECHECK(n,numeric)
-        TYPECHECK(x,numeric)
-    END_TYPECHECK(psi(n,x))
-    
-    return psi(ex_to_numeric(n), ex_to_numeric(x));
-}
-
-static ex psi_diff(ex const & n, ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-    
-    return psi(n+1, x);
-}
-
-static ex psi_series(ex const & n, ex const & x, symbol const & s, ex const & point, int order)
-{
-    throw(std::logic_error("Nobody told me how to series expand the psi function. :-("));
-}
-
-REGISTER_FUNCTION(psi, psi_eval, psi_evalf, psi_diff, psi_series);
-
-} // namespace GiNaC
diff --git a/ginac/inifcns_polylog.cpp b/ginac/inifcns_polylog.cpp
new file mode 100644 (file)
index 0000000..1fe9cd2
--- /dev/null
@@ -0,0 +1,3969 @@
+/** @file inifcns_polylog.cpp
+ *
+ *  Implementation of some special functions that have a representation as nested sums. TODO
+ *
+ *  The functions are:
+ *    classical polylogarithm              Li(n,x)
+ *    multiple polylogarithm               Li(lst(m_1,...,m_k),lst(x_1,...,x_k))
+ *                                         G(lst(a_1,...,a_k),y) or G(lst(a_1,...,a_k),lst(s_1,...,s_k),y)
+ *    Nielsen's generalized polylogarithm  S(n,p,x)
+ *    harmonic polylogarithm               H(m,x) or H(lst(m_1,...,m_k),x)
+ *    multiple zeta value                  zeta(m) or zeta(lst(m_1,...,m_k))
+ *    alternating Euler sum                zeta(m,s) or zeta(lst(m_1,...,m_k),lst(s_1,...,s_k))
+ *
+ *  Some remarks:
+ *
+ *    - All formulae used can be looked up in the following publications:
+ *      [Kol] Nielsen's Generalized Polylogarithms, K.S.Kolbig, SIAM J.Math.Anal. 17 (1986), pp. 1232-1258.
+ *      [Cra] Fast Evaluation of Multiple Zeta Sums, R.E.Crandall, Math.Comp. 67 (1998), pp. 1163-1172.
+ *      [ReV] Harmonic Polylogarithms, E.Remiddi, J.A.M.Vermaseren, Int.J.Mod.Phys. A15 (2000), pp. 725-754
+ *      [BBB] Special Values of Multiple Polylogarithms, J.Borwein, D.Bradley, D.Broadhurst, P.Lisonek, Trans.Amer.Math.Soc. 353/3 (2001), pp. 907-941
+ *      [VSW] Numerical evaluation of multiple polylogarithms, J.Vollinga, S.Weinzierl, hep-ph/0410259
+ *
+ *    - The order of parameters and arguments of Li and zeta is defined according to the nested sums
+ *      representation. The parameters for H are understood as in [ReV]. They can be in expanded --- only
+ *      0, 1 and -1 --- or in compactified --- a string with zeros in front of 1 or -1 is written as a single
+ *      number --- notation.
+ *
+ *    - All functions can be nummerically evaluated with arguments in the whole complex plane. The parameters
+ *      for Li, zeta and S must be positive integers. If you want to have an alternating Euler sum, you have
+ *      to give the signs of the parameters as a second argument s to zeta(m,s) containing 1 and -1.
+ *
+ *    - The calculation of classical polylogarithms is speeded up by using Bernoulli numbers and 
+ *      look-up tables. S uses look-up tables as well. The zeta function applies the algorithms in
+ *      [Cra] and [BBB] for speed up. Multiple polylogarithms use Hoelder convolution [BBB].
+ *
+ *    - The functions have no means to do a series expansion into nested sums. To do this, you have to convert
+ *      these functions into the appropriate objects from the nestedsums library, do the expansion and convert
+ *      the result back.
+ *
+ *    - Numerical testing of this implementation has been performed by doing a comparison of results
+ *      between this software and the commercial M.......... 4.1. Multiple zeta values have been checked
+ *      by means of evaluations into simple zeta values. Harmonic polylogarithms have been checked by
+ *      comparison to S(n,p,x) for corresponding parameter combinations and by continuity checks
+ *      around |x|=1 along with comparisons to corresponding zeta functions. Multiple polylogarithms were
+ *      checked against H and zeta and by means of shuffle and quasi-shuffle relations.
+ *
+ */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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 "inifcns_polylog.h"
+
+#include <sstream>
+#include <stdexcept>
+#include <vector>
+#include <cln/cln.h>
+
+
+#include "inifcns.h"
+#include "inifcns_exp.h"
+#include "add.h"
+#include "constant.h"
+#include "lst.h"
+#include "mul.h"
+#include "numeric.h"
+#include "operators.h"
+#include "power.h"
+#include "pseries.h"
+#include "relational.h"
+#include "symbol.h"
+#include "utils.h"
+#include "wildcard.h"
+
+
+namespace GiNaC {
+
+
+//////////////////////////////////////////////////////////////////////
+//
+// Classical polylogarithm  Li(n,x)
+//
+// helper functions
+//
+//////////////////////////////////////////////////////////////////////
+
+
+// anonymous namespace for helper functions
+namespace {
+
+
+// lookup table for factors built from Bernoulli numbers
+// see fill_Xn()
+std::vector<std::vector<cln::cl_N> > Xn;
+// initial size of Xn that should suffice for 32bit machines (must be even)
+const int xninitsizestep = 26;
+int xninitsize = xninitsizestep;
+int xnsize = 0;
+
+
+// This function calculates the X_n. The X_n are needed for speed up of classical polylogarithms.
+// With these numbers the polylogs can be calculated as follows:
+//   Li_p (x)  =  \sum_{n=0}^\infty X_{p-2}(n) u^{n+1}/(n+1)! with  u = -log(1-x)
+//   X_0(n) = B_n (Bernoulli numbers)
+//   X_p(n) = \sum_{k=0}^n binomial(n,k) B_{n-k} / (k+1) * X_{p-1}(k)
+// The calculation of Xn depends on X0 and X{n-1}.
+// X_0 is special, it holds only the non-zero Bernoulli numbers with index 2 or greater.
+// This results in a slightly more complicated algorithm for the X_n.
+// The first index in Xn corresponds to the index of the polylog minus 2.
+// The second index in Xn corresponds to the index from the actual sum.
+void fill_Xn(int n)
+{
+       if (n>1) {
+               // calculate X_2 and higher (corresponding to Li_4 and higher)
+               std::vector<cln::cl_N> buf(xninitsize);
+               std::vector<cln::cl_N>::iterator it = buf.begin();
+               cln::cl_N result;
+               *it = -(cln::expt(cln::cl_I(2),n+1) - 1) / cln::expt(cln::cl_I(2),n+1); // i == 1
+               it++;
+               for (int i=2; i<=xninitsize; i++) {
+                       if (i&1) {
+                               result = 0; // k == 0
+                       } else {
+                               result = Xn[0][i/2-1]; // k == 0
+                       }
+                       for (int k=1; k<i-1; k++) {
+                               if ( !(((i-k) & 1) && ((i-k) > 1)) ) {
+                                       result = result + cln::binomial(i,k) * Xn[0][(i-k)/2-1] * Xn[n-1][k-1] / (k+1);
+                               }
+                       }
+                       result = result - cln::binomial(i,i-1) * Xn[n-1][i-2] / 2 / i; // k == i-1
+                       result = result + Xn[n-1][i-1] / (i+1); // k == i
+                       
+                       *it = result;
+                       it++;
+               }
+               Xn.push_back(buf);
+       } else if (n==1) {
+               // special case to handle the X_0 correct
+               std::vector<cln::cl_N> buf(xninitsize);
+               std::vector<cln::cl_N>::iterator it = buf.begin();
+               cln::cl_N result;
+               *it = cln::cl_I(-3)/cln::cl_I(4); // i == 1
+               it++;
+               *it = cln::cl_I(17)/cln::cl_I(36); // i == 2
+               it++;
+               for (int i=3; i<=xninitsize; i++) {
+                       if (i & 1) {
+                               result = -Xn[0][(i-3)/2]/2;
+                               *it = (cln::binomial(i,1)/cln::cl_I(2) + cln::binomial(i,i-1)/cln::cl_I(i))*result;
+                               it++;
+                       } else {
+                               result = Xn[0][i/2-1] + Xn[0][i/2-1]/(i+1);
+                               for (int k=1; k<i/2; k++) {
+                                       result = result + cln::binomial(i,k*2) * Xn[0][k-1] * Xn[0][i/2-k-1] / (k*2+1);
+                               }
+                               *it = result;
+                               it++;
+                       }
+               }
+               Xn.push_back(buf);
+       } else {
+               // calculate X_0
+               std::vector<cln::cl_N> buf(xninitsize/2);
+               std::vector<cln::cl_N>::iterator it = buf.begin();
+               for (int i=1; i<=xninitsize/2; i++) {
+                       *it = bernoulli(i*2).to_cl_N();
+                       it++;
+               }
+               Xn.push_back(buf);
+       }
+
+       xnsize++;
+}
+
+// doubles the number of entries in each Xn[]
+void double_Xn()
+{
+       const int pos0 = xninitsize / 2;
+       // X_0
+       for (int i=1; i<=xninitsizestep/2; ++i) {
+               Xn[0].push_back(bernoulli((i+pos0)*2).to_cl_N());
+       }
+       if (Xn.size() > 1) {
+               int xend = xninitsize + xninitsizestep;
+               cln::cl_N result;
+               // X_1
+               for (int i=xninitsize+1; i<=xend; ++i) {
+                       if (i & 1) {
+                               result = -Xn[0][(i-3)/2]/2;
+                               Xn[1].push_back((cln::binomial(i,1)/cln::cl_I(2) + cln::binomial(i,i-1)/cln::cl_I(i))*result);
+                       } else {
+                               result = Xn[0][i/2-1] + Xn[0][i/2-1]/(i+1);
+                               for (int k=1; k<i/2; k++) {
+                                       result = result + cln::binomial(i,k*2) * Xn[0][k-1] * Xn[0][i/2-k-1] / (k*2+1);
+                               }
+                               Xn[1].push_back(result);
+                       }
+               }
+               // X_n
+               for (int n=2; n<Xn.size(); ++n) {
+                       for (int i=xninitsize+1; i<=xend; ++i) {
+                               if (i & 1) {
+                                       result = 0; // k == 0
+                               } else {
+                                       result = Xn[0][i/2-1]; // k == 0
+                               }
+                               for (int k=1; k<i-1; ++k) {
+                                       if ( !(((i-k) & 1) && ((i-k) > 1)) ) {
+                                               result = result + cln::binomial(i,k) * Xn[0][(i-k)/2-1] * Xn[n-1][k-1] / (k+1);
+                                       }
+                               }
+                               result = result - cln::binomial(i,i-1) * Xn[n-1][i-2] / 2 / i; // k == i-1
+                               result = result + Xn[n-1][i-1] / (i+1); // k == i
+                               Xn[n].push_back(result);
+                       }
+               }
+       }
+       xninitsize += xninitsizestep;
+}
+
+
+// calculates Li(2,x) without Xn
+cln::cl_N Li2_do_sum(const cln::cl_N& x)
+{
+       cln::cl_N res = x;
+       cln::cl_N resbuf;
+       cln::cl_N num = x * cln::cl_float(1, cln::float_format(Digits));
+       cln::cl_I den = 1; // n^2 = 1
+       unsigned i = 3;
+       do {
+               resbuf = res;
+               num = num * x;
+               den = den + i;  // n^2 = 4, 9, 16, ...
+               i += 2;
+               res = res + num / den;
+       } while (res != resbuf);
+       return res;
+}
+
+
+// calculates Li(2,x) with Xn
+cln::cl_N Li2_do_sum_Xn(const cln::cl_N& x)
+{
+       std::vector<cln::cl_N>::const_iterator it = Xn[0].begin();
+       std::vector<cln::cl_N>::const_iterator xend = Xn[0].end();
+       cln::cl_N u = -cln::log(1-x);
+       cln::cl_N factor = u * cln::cl_float(1, cln::float_format(Digits));
+       cln::cl_N uu = cln::square(u);
+       cln::cl_N res = u - uu/4;
+       cln::cl_N resbuf;
+       unsigned i = 1;
+       do {
+               resbuf = res;
+               factor = factor * uu / (2*i * (2*i+1));
+               res = res + (*it) * factor;
+               i++;
+               if (++it == xend) {
+                       double_Xn();
+                       it = Xn[0].begin() + (i-1);
+                       xend = Xn[0].end();
+               }
+       } while (res != resbuf);
+       return res;
+}
+
+
+// calculates Li(n,x), n>2 without Xn
+cln::cl_N Lin_do_sum(int n, const cln::cl_N& x)
+{
+       cln::cl_N factor = x * cln::cl_float(1, cln::float_format(Digits));
+       cln::cl_N res = x;
+       cln::cl_N resbuf;
+       int i=2;
+       do {
+               resbuf = res;
+               factor = factor * x;
+               res = res + factor / cln::expt(cln::cl_I(i),n);
+               i++;
+       } while (res != resbuf);
+       return res;
+}
+
+
+// calculates Li(n,x), n>2 with Xn
+cln::cl_N Lin_do_sum_Xn(int n, const cln::cl_N& x)
+{
+       std::vector<cln::cl_N>::const_iterator it = Xn[n-2].begin();
+       std::vector<cln::cl_N>::const_iterator xend = Xn[n-2].end();
+       cln::cl_N u = -cln::log(1-x);
+       cln::cl_N factor = u * cln::cl_float(1, cln::float_format(Digits));
+       cln::cl_N res = u;
+       cln::cl_N resbuf;
+       unsigned i=2;
+       do {
+               resbuf = res;
+               factor = factor * u / i;
+               res = res + (*it) * factor;
+               i++;
+               if (++it == xend) {
+                       double_Xn();
+                       it = Xn[n-2].begin() + (i-2);
+                       xend = Xn[n-2].end();
+               }
+       } while (res != resbuf);
+       return res;
+}
+
+
+// forward declaration needed by function Li_projection and C below
+numeric S_num(int n, int p, const numeric& x);
+
+
+// helper function for classical polylog Li
+cln::cl_N Li_projection(int n, const cln::cl_N& x, const cln::float_format_t& prec)
+{
+       // treat n=2 as special case
+       if (n == 2) {
+               // check if precalculated X0 exists
+               if (xnsize == 0) {
+                       fill_Xn(0);
+               }
+
+               if (cln::realpart(x) < 0.5) {
+                       // choose the faster algorithm
+                       // the switching point was empirically determined. the optimal point
+                       // depends on hardware, Digits, ... so an approx value is okay.
+                       // it solves also the problem with precision due to the u=-log(1-x) transformation
+                       if (cln::abs(cln::realpart(x)) < 0.25) {
+                               
+                               return Li2_do_sum(x);
+                       } else {
+                               return Li2_do_sum_Xn(x);
+                       }
+               } else {
+                       // choose the faster algorithm
+                       if (cln::abs(cln::realpart(x)) > 0.75) {
+                               return -Li2_do_sum(1-x) - cln::log(x) * cln::log(1-x) + cln::zeta(2);
+                       } else {
+                               return -Li2_do_sum_Xn(1-x) - cln::log(x) * cln::log(1-x) + cln::zeta(2);
+                       }
+               }
+       } else {
+               // check if precalculated Xn exist
+               if (n > xnsize+1) {
+                       for (int i=xnsize; i<n-1; i++) {
+                               fill_Xn(i);
+                       }
+               }
+
+               if (cln::realpart(x) < 0.5) {
+                       // choose the faster algorithm
+                       // with n>=12 the "normal" summation always wins against the method with Xn
+                       if ((cln::abs(cln::realpart(x)) < 0.3) || (n >= 12)) {
+                               return Lin_do_sum(n, x);
+                       } else {
+                               return Lin_do_sum_Xn(n, x);
+                       }
+               } else {
+                       cln::cl_N result = -cln::expt(cln::log(x), n-1) * cln::log(1-x) / cln::factorial(n-1);
+                       for (int j=0; j<n-1; j++) {
+                               result = result + (S_num(n-j-1, 1, 1).to_cl_N() - S_num(1, n-j-1, 1-x).to_cl_N())
+                                                 * cln::expt(cln::log(x), j) / cln::factorial(j);
+                       }
+                       return result;
+               }
+       }
+}
+
+
+// helper function for classical polylog Li
+numeric Lin_numeric(int n, const numeric& x)
+{
+       if (n == 1) {
+               // just a log
+               return -cln::log(1-x.to_cl_N());
+       }
+       if (x.is_zero()) {
+               return 0;
+       }
+       if (x == 1) {
+               // [Kol] (2.22)
+               return cln::zeta(n);
+       }
+       else if (x == -1) {
+               // [Kol] (2.22)
+               return -(1-cln::expt(cln::cl_I(2),1-n)) * cln::zeta(n);
+       }
+       if (abs(x.real()) < 0.4 && abs(abs(x)-1) < 0.01) {
+               cln::cl_N x_ = ex_to<numeric>(x).to_cl_N();
+               cln::cl_N result = -cln::expt(cln::log(x_), n-1) * cln::log(1-x_) / cln::factorial(n-1);
+               for (int j=0; j<n-1; j++) {
+                       result = result + (S_num(n-j-1, 1, 1).to_cl_N() - S_num(1, n-j-1, 1-x_).to_cl_N())
+                               * cln::expt(cln::log(x_), j) / cln::factorial(j);
+               }
+               return result;
+       }
+
+       // what is the desired float format?
+       // first guess: default format
+       cln::float_format_t prec = cln::default_float_format;
+       const cln::cl_N value = x.to_cl_N();
+       // second guess: the argument's format
+       if (!x.real().is_rational())
+               prec = cln::float_format(cln::the<cln::cl_F>(cln::realpart(value)));
+       else if (!x.imag().is_rational())
+               prec = cln::float_format(cln::the<cln::cl_F>(cln::imagpart(value)));
+       
+       // [Kol] (5.15)
+       if (cln::abs(value) > 1) {
+               cln::cl_N result = -cln::expt(cln::log(-value),n) / cln::factorial(n);
+               // check if argument is complex. if it is real, the new polylog has to be conjugated.
+               if (cln::zerop(cln::imagpart(value))) {
+                       if (n & 1) {
+                               result = result + cln::conjugate(Li_projection(n, cln::recip(value), prec));
+                       }
+                       else {
+                               result = result - cln::conjugate(Li_projection(n, cln::recip(value), prec));
+                       }
+               }
+               else {
+                       if (n & 1) {
+                               result = result + Li_projection(n, cln::recip(value), prec);
+                       }
+                       else {
+                               result = result - Li_projection(n, cln::recip(value), prec);
+                       }
+               }
+               cln::cl_N add;
+               for (int j=0; j<n-1; j++) {
+                       add = add + (1+cln::expt(cln::cl_I(-1),n-j)) * (1-cln::expt(cln::cl_I(2),1-n+j))
+                                   * Lin_numeric(n-j,1).to_cl_N() * cln::expt(cln::log(-value),j) / cln::factorial(j);
+               }
+               result = result - add;
+               return result;
+       }
+       else {
+               return Li_projection(n, value, prec);
+       }
+}
+
+
+} // end of anonymous namespace
+
+
+//////////////////////////////////////////////////////////////////////
+//
+// Multiple polylogarithm  Li(n,x)
+//
+// helper function
+//
+//////////////////////////////////////////////////////////////////////
+
+
+// anonymous namespace for helper function
+namespace {
+
+
+// performs the actual series summation for multiple polylogarithms
+cln::cl_N multipleLi_do_sum(const std::vector<int>& s, const std::vector<cln::cl_N>& x)
+{
+       const int j = s.size();
+
+       std::vector<cln::cl_N> t(j);
+       cln::cl_F one = cln::cl_float(1, cln::float_format(Digits));
+
+       cln::cl_N t0buf;
+       int q = 0;
+       do {
+               t0buf = t[0];
+               // do it once ...
+               q++;
+               t[j-1] = t[j-1] + cln::expt(x[j-1], q) / cln::expt(cln::cl_I(q),s[j-1]) * one;
+               for (int k=j-2; k>=0; k--) {
+                       t[k] = t[k] + t[k+1] * cln::expt(x[k], q+j-1-k) / cln::expt(cln::cl_I(q+j-1-k), s[k]);
+               }
+               // ... and do it again (to avoid premature drop out due to special arguments)
+               q++;
+               t[j-1] = t[j-1] + cln::expt(x[j-1], q) / cln::expt(cln::cl_I(q),s[j-1]) * one;
+               for (int k=j-2; k>=0; k--) {
+                       t[k] = t[k] + t[k+1] * cln::expt(x[k], q+j-1-k) / cln::expt(cln::cl_I(q+j-1-k), s[k]);
+               }
+       } while (t[0] != t0buf);
+
+       return t[0];
+}
+
+
+// converts parameter types and calls multipleLi_do_sum (convenience function for G_numeric)
+cln::cl_N mLi_do_summation(const lst& m, const lst& x)
+{
+       std::vector<int> m_int;
+       std::vector<cln::cl_N> x_cln;
+       for (lst::const_iterator itm = m.begin(), itx = x.begin(); itm != m.end(); ++itm, ++itx) {
+               m_int.push_back(ex_to<numeric>(*itm).to_int());
+               x_cln.push_back(ex_to<numeric>(*itx).to_cl_N());
+       }
+       return multipleLi_do_sum(m_int, x_cln);
+}
+
+
+// forward declaration for Li_eval()
+lst convert_parameter_Li_to_H(const lst& m, const lst& x, ex& pf);
+
+
+// holding dummy-symbols for the G/Li transformations
+std::vector<ex> gsyms;
+
+
+// type used by the transformation functions for G
+typedef std::vector<int> Gparameter;
+
+
+// G_eval1-function for G transformations
+ex G_eval1(int a, int scale)
+{
+       if (a != 0) {
+               const ex& scs = gsyms[std::abs(scale)];
+               const ex& as = gsyms[std::abs(a)];
+               if (as != scs) {
+                       return -log(1 - scs/as);
+               } else {
+                       return -zeta(1);
+               }
+       } else {
+               return log(gsyms[std::abs(scale)]);
+       }
+}
+
+
+// G_eval-function for G transformations
+ex G_eval(const Gparameter& a, int scale)
+{
+       // check for properties of G
+       ex sc = gsyms[std::abs(scale)];
+       lst newa;
+       bool all_zero = true;
+       bool all_ones = true;
+       int count_ones = 0;
+       for (Gparameter::const_iterator it = a.begin(); it != a.end(); ++it) {
+               if (*it != 0) {
+                       const ex sym = gsyms[std::abs(*it)];
+                       newa.append(sym);
+                       all_zero = false;
+                       if (sym != sc) {
+                               all_ones = false;
+                       }
+                       if (all_ones) {
+                               ++count_ones;
+                       }
+               } else {
+                       all_ones = false;
+               }
+       }
+
+       // care about divergent G: shuffle to separate divergencies that will be canceled
+       // later on in the transformation
+       if (newa.nops() > 1 && newa.op(0) == sc && !all_ones && a.front()!=0) {
+               // do shuffle
+               Gparameter short_a;
+               Gparameter::const_iterator it = a.begin();
+               ++it;
+               for (; it != a.end(); ++it) {
+                       short_a.push_back(*it);
+               }
+               ex result = G_eval1(a.front(), scale) * G_eval(short_a, scale);
+               it = short_a.begin();
+               for (int i=1; i<count_ones; ++i) {
+                       ++it;
+               }
+               for (; it != short_a.end(); ++it) {
+
+                       Gparameter newa;
+                       Gparameter::const_iterator it2 = short_a.begin();
+                       for (--it2; it2 != it;) {
+                               ++it2;
+                               newa.push_back(*it2);
+                       }
+                       newa.push_back(a[0]);
+                       ++it2;
+                       for (; it2 != short_a.end(); ++it2) {
+                               newa.push_back(*it2);   
+                       }
+                       result -= G_eval(newa, scale);
+               }
+               return result / count_ones;
+       }
+
+       // G({1,...,1};y) -> G({1};y)^k / k!
+       if (all_ones && a.size() > 1) {
+               return pow(G_eval1(a.front(),scale), count_ones) / factorial(count_ones);
+       }
+
+       // G({0,...,0};y) -> log(y)^k / k!
+       if (all_zero) {
+               return pow(log(gsyms[std::abs(scale)]), a.size()) / factorial(a.size());
+       }
+
+       // no special cases anymore -> convert it into Li
+       lst m;
+       lst x;
+       ex argbuf = gsyms[std::abs(scale)];
+       ex mval = _ex1;
+       for (Gparameter::const_iterator it=a.begin(); it!=a.end(); ++it) {
+               if (*it != 0) {
+                       const ex& sym = gsyms[std::abs(*it)];
+                       x.append(argbuf / sym);
+                       m.append(mval);
+                       mval = _ex1;
+                       argbuf = sym;
+               } else {
+                       ++mval;
+               }
+       }
+       return pow(-1, x.nops()) * Li(m, x);
+}
+
+
+// converts data for G: pending_integrals -> a
+Gparameter convert_pending_integrals_G(const Gparameter& pending_integrals)
+{
+       GINAC_ASSERT(pending_integrals.size() != 1);
+
+       if (pending_integrals.size() > 0) {
+               // get rid of the first element, which would stand for the new upper limit
+               Gparameter new_a(pending_integrals.begin()+1, pending_integrals.end());
+               return new_a;
+       } else {
+               // just return empty parameter list
+               Gparameter new_a;
+               return new_a;
+       }
+}
+
+
+// check the parameters a and scale for G and return information about convergence, depth, etc.
+// convergent     : true if G(a,scale) is convergent
+// depth          : depth of G(a,scale)
+// trailing_zeros : number of trailing zeros of a
+// min_it         : iterator of a pointing on the smallest element in a
+Gparameter::const_iterator check_parameter_G(const Gparameter& a, int scale,
+               bool& convergent, int& depth, int& trailing_zeros, Gparameter::const_iterator& min_it)
+{
+       convergent = true;
+       depth = 0;
+       trailing_zeros = 0;
+       min_it = a.end();
+       Gparameter::const_iterator lastnonzero = a.end();
+       for (Gparameter::const_iterator it = a.begin(); it != a.end(); ++it) {
+               if (std::abs(*it) > 0) {
+                       ++depth;
+                       trailing_zeros = 0;
+                       lastnonzero = it;
+                       if (std::abs(*it) < scale) {
+                               convergent = false;
+                               if ((min_it == a.end()) || (std::abs(*it) < std::abs(*min_it))) {
+                                       min_it = it;
+                               }
+                       }
+               } else {
+                       ++trailing_zeros;
+               }
+       }
+       return ++lastnonzero;
+}
+
+
+// add scale to pending_integrals if pending_integrals is empty
+Gparameter prepare_pending_integrals(const Gparameter& pending_integrals, int scale)
+{
+       GINAC_ASSERT(pending_integrals.size() != 1);
+
+       if (pending_integrals.size() > 0) {
+               return pending_integrals;
+       } else {
+               Gparameter new_pending_integrals;
+               new_pending_integrals.push_back(scale);
+               return new_pending_integrals;
+       }
+}
+
+
+// handles trailing zeroes for an otherwise convergent integral
+ex trailing_zeros_G(const Gparameter& a, int scale)
+{
+       bool convergent;
+       int depth, trailing_zeros;
+       Gparameter::const_iterator last, dummyit;
+       last = check_parameter_G(a, scale, convergent, depth, trailing_zeros, dummyit);
+
+       GINAC_ASSERT(convergent);
+
+       if ((trailing_zeros > 0) && (depth > 0)) {
+               ex result;
+               Gparameter new_a(a.begin(), a.end()-1);
+               result += G_eval1(0, scale) * trailing_zeros_G(new_a, scale);
+               for (Gparameter::const_iterator it = a.begin(); it != last; ++it) {
+                       Gparameter new_a(a.begin(), it);
+                       new_a.push_back(0);
+                       new_a.insert(new_a.end(), it, a.end()-1);
+                       result -= trailing_zeros_G(new_a, scale);
+               }
+
+               return result / trailing_zeros;
+       } else {
+               return G_eval(a, scale);
+       }
+}
+
+
+// G transformation [VSW] (57),(58)
+ex depth_one_trafo_G(const Gparameter& pending_integrals, const Gparameter& a, int scale)
+{
+       // pendint = ( y1, b1, ..., br )
+       //       a = ( 0, ..., 0, amin )
+       //   scale = y2
+       //
+       // int_0^y1 ds1/(s1-b1) ... int dsr/(sr-br) G(0, ..., 0, sr; y2)
+       // where sr replaces amin
+
+       GINAC_ASSERT(a.back() != 0);
+       GINAC_ASSERT(a.size() > 0);
+
+       ex result;
+       Gparameter new_pending_integrals = prepare_pending_integrals(pending_integrals, std::abs(a.back()));
+       const int psize = pending_integrals.size();
+
+       // length == 1
+       // G(sr_{+-}; y2 ) = G(y2_{-+}; sr) - G(0; sr) + ln(-y2_{-+})
+
+       if (a.size() == 1) {
+
+         // ln(-y2_{-+})
+         result += log(gsyms[ex_to<numeric>(scale).to_int()]);
+               if (a.back() > 0) {
+                       new_pending_integrals.push_back(-scale);
+                       result += I*Pi;
+               } else {
+                       new_pending_integrals.push_back(scale);
+                       result -= I*Pi;
+               }
+               if (psize) {
+                       result *= trailing_zeros_G(convert_pending_integrals_G(pending_integrals), pending_integrals.front());
+               }
+               
+               // G(y2_{-+}; sr)
+               result += trailing_zeros_G(convert_pending_integrals_G(new_pending_integrals), new_pending_integrals.front());
+               
+               // G(0; sr)
+               new_pending_integrals.back() = 0;
+               result -= trailing_zeros_G(convert_pending_integrals_G(new_pending_integrals), new_pending_integrals.front());
+
+               return result;
+       }
+
+       // length > 1
+       // G_m(sr_{+-}; y2) = -zeta_m + int_0^y2 dt/t G_{m-1}( (1/y2)_{+-}; 1/t )
+       //                            - int_0^sr dt/t G_{m-1}( (1/y2)_{+-}; 1/t )
+
+       //term zeta_m
+       result -= zeta(a.size());
+       if (psize) {
+               result *= trailing_zeros_G(convert_pending_integrals_G(pending_integrals), pending_integrals.front());
+       }
+       
+       // term int_0^sr dt/t G_{m-1}( (1/y2)_{+-}; 1/t )
+       //    = int_0^sr dt/t G_{m-1}( t_{+-}; y2 )
+       Gparameter new_a(a.begin()+1, a.end());
+       new_pending_integrals.push_back(0);
+       result -= depth_one_trafo_G(new_pending_integrals, new_a, scale);
+       
+       // term int_0^y2 dt/t G_{m-1}( (1/y2)_{+-}; 1/t )
+       //    = int_0^y2 dt/t G_{m-1}( t_{+-}; y2 )
+       Gparameter new_pending_integrals_2;
+       new_pending_integrals_2.push_back(scale);
+       new_pending_integrals_2.push_back(0);
+       if (psize) {
+               result += trailing_zeros_G(convert_pending_integrals_G(pending_integrals), pending_integrals.front())
+                         * depth_one_trafo_G(new_pending_integrals_2, new_a, scale);
+       } else {
+               result += depth_one_trafo_G(new_pending_integrals_2, new_a, scale);
+       }
+
+       return result;
+}
+
+
+// forward declaration
+ex shuffle_G(const Gparameter & a0, const Gparameter & a1, const Gparameter & a2,
+            const Gparameter& pendint, const Gparameter& a_old, int scale);
+
+
+// G transformation [VSW]
+ex G_transform(const Gparameter& pendint, const Gparameter& a, int scale)
+{
+       // main recursion routine
+       //
+       // pendint = ( y1, b1, ..., br )
+       //       a = ( a1, ..., amin, ..., aw )
+       //   scale = y2
+       //
+       // int_0^y1 ds1/(s1-b1) ... int dsr/(sr-br) G(a1,...,sr,...,aw,y2)
+       // where sr replaces amin
+
+       // find smallest alpha, determine depth and trailing zeros, and check for convergence
+       bool convergent;
+       int depth, trailing_zeros;
+       Gparameter::const_iterator min_it;
+       Gparameter::const_iterator firstzero = 
+               check_parameter_G(a, scale, convergent, depth, trailing_zeros, min_it);
+       int min_it_pos = min_it - a.begin();
+
+       // special case: all a's are zero
+       if (depth == 0) {
+               ex result;
+
+               if (a.size() == 0) {
+                 result = 1;
+               } else {
+                 result = G_eval(a, scale);
+               }
+               if (pendint.size() > 0) {
+                 result *= trailing_zeros_G(convert_pending_integrals_G(pendint), pendint.front());
+               } 
+               return result;
+       }
+
+       // handle trailing zeros
+       if (trailing_zeros > 0) {
+               ex result;
+               Gparameter new_a(a.begin(), a.end()-1);
+               result += G_eval1(0, scale) * G_transform(pendint, new_a, scale);
+               for (Gparameter::const_iterator it = a.begin(); it != firstzero; ++it) {
+                       Gparameter new_a(a.begin(), it);
+                       new_a.push_back(0);
+                       new_a.insert(new_a.end(), it, a.end()-1);
+                       result -= G_transform(pendint, new_a, scale);
+               }
+               return result / trailing_zeros;
+       }
+
+       // convergence case
+       if (convergent) {
+               if (pendint.size() > 0) {
+                       return G_eval(convert_pending_integrals_G(pendint), pendint.front()) * G_eval(a, scale);
+               } else {
+                       return G_eval(a, scale);
+               }
+       }
+
+       // call basic transformation for depth equal one
+       if (depth == 1) {
+               return depth_one_trafo_G(pendint, a, scale);
+       }
+
+       // do recursion
+       // int_0^y1 ds1/(s1-b1) ... int dsr/(sr-br) G(a1,...,sr,...,aw,y2)
+       //  =  int_0^y1 ds1/(s1-b1) ... int dsr/(sr-br) G(a1,...,0,...,aw,y2)
+       //   + int_0^y1 ds1/(s1-b1) ... int dsr/(sr-br) int_0^{sr} ds_{r+1} d/ds_{r+1} G(a1,...,s_{r+1},...,aw,y2)
+
+       // smallest element in last place
+       if (min_it + 1 == a.end()) {
+               do { --min_it; } while (*min_it == 0);
+               Gparameter empty;
+               Gparameter a1(a.begin(),min_it+1);
+               Gparameter a2(min_it+1,a.end());
+
+               ex result = G_transform(pendint,a2,scale)*G_transform(empty,a1,scale);
+
+               result -= shuffle_G(empty,a1,a2,pendint,a,scale);
+               return result;
+       }
+
+       Gparameter empty;
+       Gparameter::iterator changeit;
+
+       // first term G(a_1,..,0,...,a_w;a_0)
+       Gparameter new_pendint = prepare_pending_integrals(pendint, a[min_it_pos]);
+       Gparameter new_a = a;
+       new_a[min_it_pos] = 0;
+       ex result = G_transform(empty, new_a, scale);
+       if (pendint.size() > 0) {
+               result *= trailing_zeros_G(convert_pending_integrals_G(pendint), pendint.front());
+       }
+
+       // other terms
+       changeit = new_a.begin() + min_it_pos;
+       changeit = new_a.erase(changeit);
+       if (changeit != new_a.begin()) {
+               // smallest in the middle
+               new_pendint.push_back(*changeit);
+               result -= trailing_zeros_G(convert_pending_integrals_G(new_pendint), new_pendint.front())
+                       * G_transform(empty, new_a, scale);
+               int buffer = *changeit;
+               *changeit = *min_it;
+               result += G_transform(new_pendint, new_a, scale);
+               *changeit = buffer;
+               new_pendint.pop_back();
+               --changeit;
+               new_pendint.push_back(*changeit);
+               result += trailing_zeros_G(convert_pending_integrals_G(new_pendint), new_pendint.front())
+                       * G_transform(empty, new_a, scale);
+               *changeit = *min_it;
+               result -= G_transform(new_pendint, new_a, scale);
+       } else {
+               // smallest at the front
+               new_pendint.push_back(scale);
+               result += trailing_zeros_G(convert_pending_integrals_G(new_pendint), new_pendint.front())
+                       * G_transform(empty, new_a, scale);
+               new_pendint.back() =  *changeit;
+               result -= trailing_zeros_G(convert_pending_integrals_G(new_pendint), new_pendint.front())
+                       * G_transform(empty, new_a, scale);
+               *changeit = *min_it;
+               result += G_transform(new_pendint, new_a, scale);
+       }
+       return result;
+}
+
+
+// shuffles the two parameter list a1 and a2 and calls G_transform for every term except
+// for the one that is equal to a_old
+ex shuffle_G(const Gparameter & a0, const Gparameter & a1, const Gparameter & a2,
+            const Gparameter& pendint, const Gparameter& a_old, int scale) 
+{
+       if (a1.size()==0 && a2.size()==0) {
+               // veto the one configuration we don't want
+               if ( a0 == a_old ) return 0;
+
+               return G_transform(pendint,a0,scale);
+       }
+
+       if (a2.size()==0) {
+               Gparameter empty;
+               Gparameter aa0 = a0;
+               aa0.insert(aa0.end(),a1.begin(),a1.end());
+               return shuffle_G(aa0,empty,empty,pendint,a_old,scale);
+       }
+
+       if (a1.size()==0) {
+               Gparameter empty;
+               Gparameter aa0 = a0;
+               aa0.insert(aa0.end(),a2.begin(),a2.end());
+               return shuffle_G(aa0,empty,empty,pendint,a_old,scale);
+       }
+
+       Gparameter a1_removed(a1.begin()+1,a1.end());
+       Gparameter a2_removed(a2.begin()+1,a2.end());
+
+       Gparameter a01 = a0;
+       Gparameter a02 = a0;
+
+       a01.push_back( a1[0] );
+       a02.push_back( a2[0] );
+
+       return shuffle_G(a01,a1_removed,a2,pendint,a_old,scale)
+            + shuffle_G(a02,a1,a2_removed,pendint,a_old,scale);
+}
+
+
+// handles the transformations and the numerical evaluation of G
+// the parameter x, s and y must only contain numerics
+ex G_numeric(const lst& x, const lst& s, const ex& y)
+{
+       // check for convergence and necessary accelerations
+       bool need_trafo = false;
+       bool need_hoelder = false;
+       int depth = 0;
+       for (lst::const_iterator it = x.begin(); it != x.end(); ++it) {
+               if (!(*it).is_zero()) {
+                       ++depth;
+                       if (abs(*it) - y < -pow(10,-Digits+2)) {
+                               need_trafo = true;
+                               break;
+                       }
+                       if (abs((abs(*it) - y)/y) < 0.01) {
+                               need_hoelder = true;
+                       }
+               }
+       }
+       if (x.op(x.nops()-1).is_zero()) {
+               need_trafo = true;
+       }
+       if (depth == 1 && !need_trafo) {
+               return -Li(x.nops(), y / x.op(x.nops()-1)).evalf();
+       }
+       
+       // convergence transformation
+       if (need_trafo) {
+
+               // sort (|x|<->position) to determine indices
+               std::multimap<ex,int> sortmap;
+               int size = 0;
+               for (int i=0; i<x.nops(); ++i) {
+                       if (!x[i].is_zero()) {
+                               sortmap.insert(std::pair<ex,int>(abs(x[i]), i));
+                               ++size;
+                       }
+               }
+               // include upper limit (scale)
+               sortmap.insert(std::pair<ex,int>(abs(y), x.nops()));
+
+               // generate missing dummy-symbols
+               int i = 1;
+               gsyms.clear();
+               gsyms.push_back(symbol("GSYMS_ERROR"));
+               ex lastentry;
+               for (std::multimap<ex,int>::const_iterator it = sortmap.begin(); it != sortmap.end(); ++it) {
+                       if (it != sortmap.begin()) {
+                               if (it->second < x.nops()) {
+                                       if (x[it->second] == lastentry) {
+                                               gsyms.push_back(gsyms.back());
+                                               continue;
+                                       }
+                               } else {
+                                       if (y == lastentry) {
+                                               gsyms.push_back(gsyms.back());
+                                               continue;
+                                       }
+                               }
+                       }
+                       std::ostringstream os;
+                       os << "a" << i;
+                       gsyms.push_back(symbol(os.str()));
+                       ++i;
+                       if (it->second < x.nops()) {
+                               lastentry = x[it->second];
+                       } else {
+                               lastentry = y;
+                       }
+               }
+
+               // fill position data according to sorted indices and prepare substitution list
+               Gparameter a(x.nops());
+               lst subslst;
+               int pos = 1;
+               int scale;
+               for (std::multimap<ex,int>::const_iterator it = sortmap.begin(); it != sortmap.end(); ++it) {
+                       if (it->second < x.nops()) {
+                               if (s[it->second] > 0) {
+                                       a[it->second] = pos;
+                               } else {
+                                       a[it->second] = -pos;
+                               }
+                               subslst.append(gsyms[pos] == x[it->second]);
+                       } else {
+                               scale = pos;
+                               subslst.append(gsyms[pos] == y);
+                       }
+                       ++pos;
+               }
+
+               // do transformation
+               Gparameter pendint;
+               ex result = G_transform(pendint, a, scale);
+               // replace dummy symbols with their values
+               result = result.eval().expand();
+               result = result.subs(subslst).evalf();
+               
+               return result;
+       }
+
+       // do acceleration transformation (hoelder convolution [BBB])
+       if (need_hoelder) {
+               
+               ex result;
+               const int size = x.nops();
+               lst newx;
+               for (lst::const_iterator it = x.begin(); it != x.end(); ++it) {
+                       newx.append(*it / y);
+               }
+               
+               for (int r=0; r<=size; ++r) {
+                       ex buffer = pow(-1, r);
+                       ex p = 2;
+                       bool adjustp;
+                       do {
+                               adjustp = false;
+                               for (lst::const_iterator it = newx.begin(); it != newx.end(); ++it) {
+                                       if (*it == 1/p) {
+                                               p += (3-p)/2; 
+                                               adjustp = true;
+                                               continue;
+                                       }
+                               }
+                       } while (adjustp);
+                       ex q = p / (p-1);
+                       lst qlstx;
+                       lst qlsts;
+                       for (int j=r; j>=1; --j) {
+                               qlstx.append(1-newx.op(j-1));
+                               if (newx.op(j-1).info(info_flags::real) && newx.op(j-1) > 1 && newx.op(j-1) <= 2) {
+                                       qlsts.append( s.op(j-1));
+                               } else {
+                                       qlsts.append( -s.op(j-1));
+                               }
+                       }
+                       if (qlstx.nops() > 0) {
+                               buffer *= G_numeric(qlstx, qlsts, 1/q);
+                       }
+                       lst plstx;
+                       lst plsts;
+                       for (int j=r+1; j<=size; ++j) {
+                               plstx.append(newx.op(j-1));
+                               plsts.append(s.op(j-1));
+                       }
+                       if (plstx.nops() > 0) {
+                               buffer *= G_numeric(plstx, plsts, 1/p);
+                       }
+                       result += buffer;
+               }
+               return result;
+       }
+       
+       // do summation
+       lst newx;
+       lst m;
+       int mcount = 1;
+       ex sign = 1;
+       ex factor = y;
+       for (lst::const_iterator it = x.begin(); it != x.end(); ++it) {
+               if ((*it).is_zero()) {
+                       ++mcount;
+               } else {
+                       newx.append(factor / (*it));
+                       factor = *it;
+                       m.append(mcount);
+                       mcount = 1;
+                       sign = -sign;
+               }
+       }
+
+       return sign * numeric(mLi_do_summation(m, newx));
+}
+
+
+ex mLi_numeric(const lst& m, const lst& x)
+{
+       // let G_numeric do the transformation
+       lst newx;
+       lst s;
+       ex factor = 1;
+       for (lst::const_iterator itm = m.begin(), itx = x.begin(); itm != m.end(); ++itm, ++itx) {
+               for (int i = 1; i < *itm; ++i) {
+                       newx.append(0);
+                       s.append(1);
+               }
+               newx.append(factor / *itx);
+               factor /= *itx;
+               s.append(1);
+       }
+       return pow(-1, m.nops()) * G_numeric(newx, s, _ex1);
+}
+
+
+} // end of anonymous namespace
+
+
+//////////////////////////////////////////////////////////////////////
+//
+// Generalized multiple polylogarithm  G(x, y) and G(x, s, y)
+//
+// GiNaC function
+//
+//////////////////////////////////////////////////////////////////////
+
+GINAC_IMPLEMENT_FUNCTION(G_function)
+
+ex G_function::eval(int level) const
+{
+       if (seq.size() == 2) {
+               const ex& x_ = seq[0];
+               const ex& y = seq[1];
+               // G2
+               //TODO eval to MZV or H or S or Lin
+               if (!y.info(info_flags::positive)) {
+                       return G(x_, y).hold();
+               }
+               lst x = is_a<lst>(x_) ? ex_to<lst>(x_) : lst(x_);
+               if (x.nops() == 0) {
+                       return _ex1;
+               }
+               if (x.op(0) == y) {
+                       return G(x_, y).hold();
+               }
+               lst s;
+               bool all_zero = true;
+               bool crational = true;
+               for (lst::const_iterator it = x.begin(); it != x.end(); ++it) {
+                       if (!(*it).info(info_flags::numeric)) {
+                               return G(x_, y).hold();
+                       }
+                       if (!(*it).info(info_flags::crational)) {
+                               crational = false;
+                       }
+                       if (*it != _ex0) {
+                               all_zero = false;
+                       }
+                       s.append(+1);
+               }
+               if (all_zero) {
+                       return pow(log(y), x.nops()) / factorial(x.nops());
+               }
+               if (!y.info(info_flags::crational)) {
+                       crational = false;
+               }
+               if (crational) {
+                       return G(x_, y).hold();
+               }
+               return G_numeric(x, s, y);
+       } else {
+               // G3
+               const ex& x_ = seq[0];
+               const ex& s_ = seq[1];
+               const ex& y = seq[2];
+               if (!y.info(info_flags::positive)) {
+                       return G(x_, s_, y).hold();
+               }
+               lst x = is_a<lst>(x_) ? ex_to<lst>(x_) : lst(x_);
+               lst s = is_a<lst>(s_) ? ex_to<lst>(s_) : lst(s_);
+               if (x.nops() != s.nops()) {
+                       return G(x_, s_, y).hold();
+               }
+               if (x.nops() == 0) {
+                       return _ex1;
+               }
+               if (x.op(0) == y) {
+                       return G(x_, s_, y).hold();
+               }
+               lst sn;
+               bool all_zero = true;
+               bool crational = true;
+               for (lst::const_iterator itx = x.begin(), its = s.begin(); itx != x.end(); ++itx, ++its) {
+                       if (!(*itx).info(info_flags::numeric)) {
+                               return G(x_, s_, y).hold();
+                       }
+                       if (!(*its).info(info_flags::real)) {
+                               return G(x_, s_, y).hold();
+                       }
+                       if (!(*itx).info(info_flags::crational)) {
+                               crational = false;
+                       }
+                       if (*itx != _ex0) {
+                               all_zero = false;
+                       }
+                       if (*its >= 0) {
+                               sn.append(+1);
+                       } else {
+                               sn.append(-1);
+                       }
+               }
+               if (all_zero) {
+                       return pow(log(y), x.nops()) / factorial(x.nops());
+               }
+               if (!y.info(info_flags::crational)) {
+                       crational = false;
+               }
+               if (crational) {
+                       return G(x_, s_, y).hold();
+               }
+               return G_numeric(x, sn, y);
+       }
+}
+
+ex G_function::evalf(int level) const
+{
+       if (seq.size() == 2) {
+               // G2
+               const ex& x_ = seq[0];
+               const ex& y = seq[1];
+               if (!y.info(info_flags::positive)) {
+                       return G(x_, y).hold();
+               }
+               lst x = is_a<lst>(x_) ? ex_to<lst>(x_) : lst(x_);
+               if (x.nops() == 0) {
+                       return _ex1;
+               }
+               if (x.op(0) == y) {
+                       return G(x_, y).hold();
+               }
+               lst s;
+               bool all_zero = true;
+               for (lst::const_iterator it = x.begin(); it != x.end(); ++it) {
+                       if (!(*it).info(info_flags::numeric)) {
+                               return G(x_, y).hold();
+                       }
+                       if (*it != _ex0) {
+                               all_zero = false;
+                       }
+                       s.append(+1);
+               }
+               if (all_zero) {
+                       return pow(log(y), x.nops()) / factorial(x.nops());
+               }
+               return G_numeric(x, s, y);
+       } else {
+               // G3
+               const ex& x_ = seq[0];
+               const ex& s_ = seq[1];
+               const ex& y = seq[2];
+               if (!y.info(info_flags::positive)) {
+                       return G(x_, s_, y).hold();
+               }
+               lst x = is_a<lst>(x_) ? ex_to<lst>(x_) : lst(x_);
+               lst s = is_a<lst>(s_) ? ex_to<lst>(s_) : lst(s_);
+               if (x.nops() != s.nops()) {
+                       return G(x_, s_, y).hold();
+               }
+               if (x.nops() == 0) {
+                       return _ex1;
+               }
+               if (x.op(0) == y) {
+                       return G(x_, s_, y).hold();
+               }
+               lst sn;
+               bool all_zero = true;
+               for (lst::const_iterator itx = x.begin(), its = s.begin(); itx != x.end(); ++itx, ++its) {
+                       if (!(*itx).info(info_flags::numeric)) {
+                               return G(x_, y).hold();
+                       }
+                       if (!(*its).info(info_flags::real)) {
+                               return G(x_, y).hold();
+                       }
+                       if (*itx != _ex0) {
+                               all_zero = false;
+                       }
+                       if (*its >= 0) {
+                               sn.append(+1);
+                       } else {
+                               sn.append(-1);
+                       }
+               }
+               if (all_zero) {
+                       return pow(log(y), x.nops()) / factorial(x.nops());
+               }
+               return G_numeric(x, sn, y);
+       }
+}
+
+//////////////////////////////////////////////////////////////////////
+//
+// Classical polylogarithm and multiple polylogarithm  Li(m,x)
+//
+// GiNaC function
+//
+//////////////////////////////////////////////////////////////////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(Li_function,
+               print_func<print_latex>(&Li_function::do_print_latex))
+
+ex Li_function::eval(int level) const
+{
+       const ex& m_ = seq[0];
+       const ex& x_ = seq[1];
+       if (is_a<lst>(m_)) {
+               if (is_a<lst>(x_)) {
+                       // multiple polylogs
+                       const lst& m = ex_to<lst>(m_);
+                       const lst& x = ex_to<lst>(x_);
+                       if (m.nops() != x.nops()) {
+                               return this->hold();
+                       }
+                       if (x.nops() == 0) {
+                               return _ex1;
+                       }
+                       bool is_H = true;
+                       bool is_zeta = true;
+                       bool do_evalf = true;
+                       bool crational = true;
+                       for (lst::const_iterator itm = m.begin(), itx = x.begin(); itm != m.end(); ++itm, ++itx) {
+                               if (!(*itm).info(info_flags::posint)) {
+                                       return this->hold();
+                               }
+                               if ((*itx != _ex1) && (*itx != _ex_1)) {
+                                       if (itx != x.begin()) {
+                                               is_H = false;
+                                       }
+                                       is_zeta = false;
+                               }
+                               if (*itx == _ex0) {
+                                       return _ex0;
+                               }
+                               if (!(*itx).info(info_flags::numeric)) {
+                                       do_evalf = false;
+                               }
+                               if (!(*itx).info(info_flags::crational)) {
+                                       crational = false;
+                               }
+                       }
+                       if (is_zeta) {
+                               return zeta(m_,x_);
+                       }
+                       if (is_H) {
+                               ex prefactor;
+                               lst newm = convert_parameter_Li_to_H(m, x, prefactor);
+                               return prefactor * H(newm, x[0]);
+                       }
+                       if (do_evalf && !crational) {
+                               return mLi_numeric(m,x);
+                       }
+               }
+               return this->hold();
+       } else if (is_a<lst>(x_)) {
+               return this->hold();
+       }
+
+       // classical polylogs
+       if (x_ == _ex0) {
+               return _ex0;
+       }
+       if (x_ == _ex1) {
+               return zeta(m_);
+       }
+       if (x_ == _ex_1) {
+               return (pow(2,1-m_)-1) * zeta(m_);
+       }
+       if (m_ == _ex1) {
+               return -log(1-x_);
+       }
+       if (m_ == _ex2) {
+               if (x_.is_equal(I)) {
+                       return GiNaC::power(Pi,_ex2)/_ex_48 + Catalan*I;
+               }
+               if (x_.is_equal(-I)) {
+                       return GiNaC::power(Pi,_ex2)/_ex_48 - Catalan*I;
+               }
+       }
+       if (m_.info(info_flags::posint) && x_.info(info_flags::numeric) && !x_.info(info_flags::crational)) {
+               return Lin_numeric(ex_to<numeric>(m_).to_int(), ex_to<numeric>(x_));
+       }
+
+       return this->hold();
+}
+
+ex Li_function::evalf(int level) const
+{
+       const ex& m_ = seq[0];
+       const ex& x_ = seq[1];
+       // classical polylogs
+       if (m_.info(info_flags::posint)) {
+               if (x_.info(info_flags::numeric)) {
+                       return Lin_numeric(ex_to<numeric>(m_).to_int(), ex_to<numeric>(x_));
+               } else {
+                       // try to numerically evaluate second argument
+                       ex x_val = x_.evalf();
+                       if (x_val.info(info_flags::numeric)) {
+                               return Lin_numeric(ex_to<numeric>(m_).to_int(), ex_to<numeric>(x_val));
+                       }
+               }
+       }
+       // multiple polylogs
+       if (is_a<lst>(m_) && is_a<lst>(x_)) {
+
+               const lst& m = ex_to<lst>(m_);
+               const lst& x = ex_to<lst>(x_);
+               if (m.nops() != x.nops()) {
+                       return this->hold();
+               }
+               if (x.nops() == 0) {
+                       return _ex1;
+               }
+               if ((m.op(0) == _ex1) && (x.op(0) == _ex1)) {
+                       return Li(m_,x_).hold();
+               }
+
+               for (lst::const_iterator itm = m.begin(), itx = x.begin(); itm != m.end(); ++itm, ++itx) {
+                       if (!(*itm).info(info_flags::posint)) {
+                               return this->hold();
+                       }
+                       if (!(*itx).info(info_flags::numeric)) {
+                               return this->hold();
+                       }
+                       if (*itx == _ex0) {
+                               return _ex0;
+                       }
+               }
+
+               return mLi_numeric(m, x);
+       }
+
+       return this->hold();
+}
+
+ex Li_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& m = seq[0];
+       const ex& x = seq[1];
+       if (is_a<lst>(m) || is_a<lst>(x)) {
+               // multiple polylog
+               epvector seq;
+               seq.push_back(expair(Li(m, x), 0));
+               return pseries(rel, seq);
+       }
+       
+       // classical polylog
+       const ex x_pt = x.subs(rel, subs_options::no_pattern);
+       if (m.info(info_flags::numeric) && x_pt.info(info_flags::numeric)) {
+               // First special case: x==0 (derivatives have poles)
+               if (x_pt.is_zero()) {
+                       const symbol s;
+                       ex ser;
+                       // manually construct the primitive expansion
+                       for (int i=1; i<order; ++i)
+                               ser += pow(s,i) / pow(numeric(i), m);
+                       // substitute the argument's series expansion
+                       ser = ser.subs(s==x.series(rel, order), subs_options::no_pattern);
+                       // maybe that was terminating, so add a proper order term
+                       epvector nseq;
+                       nseq.push_back(expair(Order(_ex1), order));
+                       ser += pseries(rel, nseq);
+                       // reexpanding it will collapse the series again
+                       return ser.series(rel, order);
+               }
+               // special cases: x==1 (branch point) and x real, >=1 (branch cut)
+               if (m.is_equal(_ex2)) {
+                       // second special case: x==1 (branch point)
+                       if (x_pt.is_equal(_ex1)) {
+                               // method:
+                               // construct series manually in a dummy symbol s
+                               const symbol s;
+                               ex ser = zeta(_ex2);
+                               // manually construct the primitive expansion
+                               for (int i=1; i<order; ++i) {
+                                       ser += pow(1-s,i) * (numeric(1,i)*(I*Pi+log(s-1)) - numeric(1,i*i));
+                               }
+                               // substitute the argument's series expansion
+                               ser = ser.subs(s==x.series(rel, order), subs_options::no_pattern);
+                               // maybe that was terminating, so add a proper order term
+                               epvector nseq;
+                               nseq.push_back(expair(Order(_ex1), order));
+                               ser += pseries(rel, nseq);
+                               // reexpanding it will collapse the series again
+                               return ser.series(rel, order);
+                       }
+                       // third special case: x real, >=1 (branch cut)
+                       if (!(options & series_options::suppress_branchcut) &&
+                                       ex_to<numeric>(x_pt).is_real() && ex_to<numeric>(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<symbol>(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 = GiNaC::series(Li2(x), s==foo, order);
+                               for (size_t i=1; i<replarg.nops()-1; ++i)
+                                       seq.push_back(expair((replarg.op(i)/power(s-foo,i)).series(foo==point,1,options).op(0).subs(foo==s, subs_options::no_pattern),i));
+                               // append an order term:
+                               seq.push_back(expair(Order(_ex1), replarg.nops()-1));
+                               return pseries(rel, seq);
+                       }
+                       // all other cases should be safe, by now:
+                       return basic::series(rel, order, options);
+               } else {
+                       throw std::runtime_error("Li_series: don't know how to do the series expansion at this point!");
+               }
+       }
+       // all other cases should be safe, by now:
+       return basic::series(rel, order, options);
+}
+
+ex Li_function::pderivative(unsigned deriv_param) const
+{
+       const ex& m_ = seq[0];
+       const ex& x_ = seq[1];
+       GINAC_ASSERT(deriv_param < 2);
+       if (deriv_param == 0) {
+               return _ex0;
+       }
+       if (m_.nops() > 1) {
+               throw std::runtime_error("don't know how to derivate multiple polylogarithm!");
+       }
+       ex m;
+       if (is_a<lst>(m_)) {
+               m = m_.op(0);
+       } else {
+               m = m_;
+       }
+       ex x;
+       if (is_a<lst>(x_)) {
+               x = x_.op(0);
+       } else {
+               x = x_;
+       }
+       if (m > 0) {
+               return Li(m-1, x) / x;
+       } else {
+               return 1/(1-x);
+       }
+}
+
+void Li_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       const ex& m_ = seq[0];
+       const ex& x_ = seq[1];
+       lst m;
+       if (is_a<lst>(m_)) {
+               m = ex_to<lst>(m_);
+       } else {
+               m = lst(m_);
+       }
+       lst x;
+       if (is_a<lst>(x_)) {
+               x = ex_to<lst>(x_);
+       } else {
+               x = lst(x_);
+       }
+       c.s << "\\mbox{Li}_{";
+       lst::const_iterator itm = m.begin();
+       (*itm).print(c);
+       itm++;
+       for (; itm != m.end(); itm++) {
+               c.s << ",";
+               (*itm).print(c);
+       }
+       c.s << "}(";
+       lst::const_iterator itx = x.begin();
+       (*itx).print(c);
+       itx++;
+       for (; itx != x.end(); itx++) {
+               c.s << ",";
+               (*itx).print(c);
+       }
+       c.s << ")";
+}
+
+//////////////////////////////////////////////////////////////////////
+//
+// Nielsen's generalized polylogarithm  S(n,p,x)
+//
+// helper functions
+//
+//////////////////////////////////////////////////////////////////////
+
+
+// anonymous namespace for helper functions
+namespace {
+
+
+// lookup table for special Euler-Zagier-Sums (used for S_n,p(x))
+// see fill_Yn()
+std::vector<std::vector<cln::cl_N> > Yn;
+int ynsize = 0; // number of Yn[]
+int ynlength = 100; // initial length of all Yn[i]
+
+
+// This function calculates the Y_n. The Y_n are needed for the evaluation of S_{n,p}(x).
+// The Y_n are basically Euler-Zagier sums with all m_i=1. They are subsums in the Z-sum
+// representing S_{n,p}(x).
+// The first index in Y_n corresponds to the parameter p minus one, i.e. the depth of the
+// equivalent Z-sum.
+// The second index in Y_n corresponds to the running index of the outermost sum in the full Z-sum
+// representing S_{n,p}(x).
+// The calculation of Y_n uses the values from Y_{n-1}.
+void fill_Yn(int n, const cln::float_format_t& prec)
+{
+       const int initsize = ynlength;
+       //const int initsize = initsize_Yn;
+       cln::cl_N one = cln::cl_float(1, prec);
+
+       if (n) {
+               std::vector<cln::cl_N> buf(initsize);
+               std::vector<cln::cl_N>::iterator it = buf.begin();
+               std::vector<cln::cl_N>::iterator itprev = Yn[n-1].begin();
+               *it = (*itprev) / cln::cl_N(n+1) * one;
+               it++;
+               itprev++;
+               // sums with an index smaller than the depth are zero and need not to be calculated.
+               // calculation starts with depth, which is n+2)
+               for (int i=n+2; i<=initsize+n; i++) {
+                       *it = *(it-1) + (*itprev) / cln::cl_N(i) * one;
+                       it++;
+                       itprev++;
+               }
+               Yn.push_back(buf);
+       } else {
+               std::vector<cln::cl_N> buf(initsize);
+               std::vector<cln::cl_N>::iterator it = buf.begin();
+               *it = 1 * one;
+               it++;
+               for (int i=2; i<=initsize; i++) {
+                       *it = *(it-1) + 1 / cln::cl_N(i) * one;
+                       it++;
+               }
+               Yn.push_back(buf);
+       }
+       ynsize++;
+}
+
+
+// make Yn longer ... 
+void make_Yn_longer(int newsize, const cln::float_format_t& prec)
+{
+
+       cln::cl_N one = cln::cl_float(1, prec);
+
+       Yn[0].resize(newsize);
+       std::vector<cln::cl_N>::iterator it = Yn[0].begin();
+       it += ynlength;
+       for (int i=ynlength+1; i<=newsize; i++) {
+               *it = *(it-1) + 1 / cln::cl_N(i) * one;
+               it++;
+       }
+
+       for (int n=1; n<ynsize; n++) {
+               Yn[n].resize(newsize);
+               std::vector<cln::cl_N>::iterator it = Yn[n].begin();
+               std::vector<cln::cl_N>::iterator itprev = Yn[n-1].begin();
+               it += ynlength;
+               itprev += ynlength;
+               for (int i=ynlength+n+1; i<=newsize+n; i++) {
+                       *it = *(it-1) + (*itprev) / cln::cl_N(i) * one;
+                       it++;
+                       itprev++;
+               }
+       }
+       
+       ynlength = newsize;
+}
+
+
+// helper function for S(n,p,x)
+// [Kol] (7.2)
+cln::cl_N C(int n, int p)
+{
+       cln::cl_N result;
+
+       for (int k=0; k<p; k++) {
+               for (int j=0; j<=(n+k-1)/2; j++) {
+                       if (k == 0) {
+                               if (n & 1) {
+                                       if (j & 1) {
+                                               result = result - 2 * cln::expt(cln::pi(),2*j) * S_num(n-2*j,p,1).to_cl_N() / cln::factorial(2*j);
+                                       }
+                                       else {
+                                               result = result + 2 * cln::expt(cln::pi(),2*j) * S_num(n-2*j,p,1).to_cl_N() / cln::factorial(2*j);
+                                       }
+                               }
+                       }
+                       else {
+                               if (k & 1) {
+                                       if (j & 1) {
+                                               result = result + cln::factorial(n+k-1)
+                                                                 * cln::expt(cln::pi(),2*j) * S_num(n+k-2*j,p-k,1).to_cl_N()
+                                                                 / (cln::factorial(k) * cln::factorial(n-1) * cln::factorial(2*j));
+                                       }
+                                       else {
+                                               result = result - cln::factorial(n+k-1)
+                                                                 * cln::expt(cln::pi(),2*j) * S_num(n+k-2*j,p-k,1).to_cl_N()
+                                                                 / (cln::factorial(k) * cln::factorial(n-1) * cln::factorial(2*j));
+                                       }
+                               }
+                               else {
+                                       if (j & 1) {
+                                               result = result - cln::factorial(n+k-1) * cln::expt(cln::pi(),2*j) * S_num(n+k-2*j,p-k,1).to_cl_N()
+                                                                 / (cln::factorial(k) * cln::factorial(n-1) * cln::factorial(2*j));
+                                       }
+                                       else {
+                                               result = result + cln::factorial(n+k-1)
+                                                                 * cln::expt(cln::pi(),2*j) * S_num(n+k-2*j,p-k,1).to_cl_N()
+                                                                 / (cln::factorial(k) * cln::factorial(n-1) * cln::factorial(2*j));
+                                       }
+                               }
+                       }
+               }
+       }
+       int np = n+p;
+       if ((np-1) & 1) {
+               if (((np)/2+n) & 1) {
+                       result = -result - cln::expt(cln::pi(),np) / (np * cln::factorial(n-1) * cln::factorial(p));
+               }
+               else {
+                       result = -result + cln::expt(cln::pi(),np) / (np * cln::factorial(n-1) * cln::factorial(p));
+               }
+       }
+
+       return result;
+}
+
+
+// helper function for S(n,p,x)
+// [Kol] remark to (9.1)
+cln::cl_N a_k(int k)
+{
+       cln::cl_N result;
+
+       if (k == 0) {
+               return 1;
+       }
+
+       result = result;
+       for (int m=2; m<=k; m++) {
+               result = result + cln::expt(cln::cl_N(-1),m) * cln::zeta(m) * a_k(k-m);
+       }
+
+       return -result / k;
+}
+
+
+// helper function for S(n,p,x)
+// [Kol] remark to (9.1)
+cln::cl_N b_k(int k)
+{
+       cln::cl_N result;
+
+       if (k == 0) {
+               return 1;
+       }
+
+       result = result;
+       for (int m=2; m<=k; m++) {
+               result = result + cln::expt(cln::cl_N(-1),m) * cln::zeta(m) * b_k(k-m);
+       }
+
+       return result / k;
+}
+
+
+// helper function for S(n,p,x)
+cln::cl_N S_do_sum(int n, int p, const cln::cl_N& x, const cln::float_format_t& prec)
+{
+       if (p==1) {
+               return Li_projection(n+1, x, prec);
+       }
+       
+       // check if precalculated values are sufficient
+       if (p > ynsize+1) {
+               for (int i=ynsize; i<p-1; i++) {
+                       fill_Yn(i, prec);
+               }
+       }
+
+       // should be done otherwise
+       cln::cl_F one = cln::cl_float(1, cln::float_format(Digits));
+       cln::cl_N xf = x * one;
+       //cln::cl_N xf = x * cln::cl_float(1, prec);
+
+       cln::cl_N res;
+       cln::cl_N resbuf;
+       cln::cl_N factor = cln::expt(xf, p);
+       int i = p;
+       do {
+               resbuf = res;
+               if (i-p >= ynlength) {
+                       // make Yn longer
+                       make_Yn_longer(ynlength*2, prec);
+               }
+               res = res + factor / cln::expt(cln::cl_I(i),n+1) * Yn[p-2][i-p]; // should we check it? or rely on magic number? ...
+               //res = res + factor / cln::expt(cln::cl_I(i),n+1) * (*it); // should we check it? or rely on magic number? ...
+               factor = factor * xf;
+               i++;
+       } while (res != resbuf);
+       
+       return res;
+}
+
+
+// helper function for S(n,p,x)
+cln::cl_N S_projection(int n, int p, const cln::cl_N& x, const cln::float_format_t& prec)
+{
+       // [Kol] (5.3)
+       if (cln::abs(cln::realpart(x)) > cln::cl_F("0.5")) {
+
+               cln::cl_N result = cln::expt(cln::cl_I(-1),p) * cln::expt(cln::log(x),n)
+                                  * cln::expt(cln::log(1-x),p) / cln::factorial(n) / cln::factorial(p);
+
+               for (int s=0; s<n; s++) {
+                       cln::cl_N res2;
+                       for (int r=0; r<p; r++) {
+                               res2 = res2 + cln::expt(cln::cl_I(-1),r) * cln::expt(cln::log(1-x),r)
+                                             * S_do_sum(p-r,n-s,1-x,prec) / cln::factorial(r);
+                       }
+                       result = result + cln::expt(cln::log(x),s) * (S_num(n-s,p,1).to_cl_N() - res2) / cln::factorial(s);
+               }
+
+               return result;
+       }
+       
+       return S_do_sum(n, p, x, prec);
+}
+
+
+// helper function for S(n,p,x)
+numeric S_num(int n, int p, const numeric& x)
+{
+       if (x == 1) {
+               if (n == 1) {
+                   // [Kol] (2.22) with (2.21)
+                       return cln::zeta(p+1);
+               }
+
+               if (p == 1) {
+                   // [Kol] (2.22)
+                       return cln::zeta(n+1);
+               }
+
+               // [Kol] (9.1)
+               cln::cl_N result;
+               for (int nu=0; nu<n; nu++) {
+                       for (int rho=0; rho<=p; rho++) {
+                               result = result + b_k(n-nu-1) * b_k(p-rho) * a_k(nu+rho+1)
+                                                 * cln::factorial(nu+rho+1) / cln::factorial(rho) / cln::factorial(nu+1);
+                       }
+               }
+               result = result * cln::expt(cln::cl_I(-1),n+p-1);
+
+               return result;
+       }
+       else if (x == -1) {
+               // [Kol] (2.22)
+               if (p == 1) {
+                       return -(1-cln::expt(cln::cl_I(2),-n)) * cln::zeta(n+1);
+               }
+//             throw std::runtime_error("don't know how to evaluate this function!");
+       }
+
+       // what is the desired float format?
+       // first guess: default format
+       cln::float_format_t prec = cln::default_float_format;
+       const cln::cl_N value = x.to_cl_N();
+       // second guess: the argument's format
+       if (!x.real().is_rational())
+               prec = cln::float_format(cln::the<cln::cl_F>(cln::realpart(value)));
+       else if (!x.imag().is_rational())
+               prec = cln::float_format(cln::the<cln::cl_F>(cln::imagpart(value)));
+
+       // [Kol] (5.3)
+       if ((cln::realpart(value) < -0.5) || (n == 0)) {
+
+               cln::cl_N result = cln::expt(cln::cl_I(-1),p) * cln::expt(cln::log(value),n)
+                                  * cln::expt(cln::log(1-value),p) / cln::factorial(n) / cln::factorial(p);
+
+               for (int s=0; s<n; s++) {
+                       cln::cl_N res2;
+                       for (int r=0; r<p; r++) {
+                               res2 = res2 + cln::expt(cln::cl_I(-1),r) * cln::expt(cln::log(1-value),r)
+                                             * S_num(p-r,n-s,1-value).to_cl_N() / cln::factorial(r);
+                       }
+                       result = result + cln::expt(cln::log(value),s) * (S_num(n-s,p,1).to_cl_N() - res2) / cln::factorial(s);
+               }
+
+               return result;
+               
+       }
+       // [Kol] (5.12)
+       if (cln::abs(value) > 1) {
+               
+               cln::cl_N result;
+
+               for (int s=0; s<p; s++) {
+                       for (int r=0; r<=s; r++) {
+                               result = result + cln::expt(cln::cl_I(-1),s) * cln::expt(cln::log(-value),r) * cln::factorial(n+s-r-1)
+                                                 / cln::factorial(r) / cln::factorial(s-r) / cln::factorial(n-1)
+                                                 * S_num(n+s-r,p-s,cln::recip(value)).to_cl_N();
+                       }
+               }
+               result = result * cln::expt(cln::cl_I(-1),n);
+
+               cln::cl_N res2;
+               for (int r=0; r<n; r++) {
+                       res2 = res2 + cln::expt(cln::log(-value),r) * C(n-r,p) / cln::factorial(r);
+               }
+               res2 = res2 + cln::expt(cln::log(-value),n+p) / cln::factorial(n+p);
+
+               result = result + cln::expt(cln::cl_I(-1),p) * res2;
+
+               return result;
+       }
+       else {
+               return S_projection(n, p, value, prec);
+       }
+}
+
+
+} // end of anonymous namespace
+
+
+//////////////////////////////////////////////////////////////////////
+//
+// Nielsen's generalized polylogarithm  S(n,p,x)
+//
+// GiNaC function
+//
+//////////////////////////////////////////////////////////////////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(S_function,
+               print_func<print_latex>(&S_function::do_print_latex))
+
+ex S_function::eval(int level) const
+{
+       const ex& n = seq[0];
+       const ex& p = seq[1];
+       const ex& x = seq[2];
+       if (n.info(info_flags::posint) && p.info(info_flags::posint)) {
+               if (x == 0) {
+                       return _ex0;
+               }
+               if (x == 1) {
+                       lst m(n+1);
+                       for (int i=ex_to<numeric>(p).to_int()-1; i>0; i--) {
+                               m.append(1);
+                       }
+                       return zeta(m);
+               }
+               if (p == 1) {
+                       return Li(n+1, x);
+               }
+               if (x.info(info_flags::numeric) && (!x.info(info_flags::crational))) {
+                       return S_num(ex_to<numeric>(n).to_int(), ex_to<numeric>(p).to_int(), ex_to<numeric>(x));
+               }
+       }
+       if (n.is_zero()) {
+               // [Kol] (5.3)
+               return pow(-log(1-x), p) / factorial(p);
+       }
+       return this->hold();
+}
+
+ex S_function::evalf(int level) const
+{
+       const ex& n = seq[0];
+       const ex& p = seq[1];
+       const ex& x = seq[2];
+       if (n.info(info_flags::posint) && p.info(info_flags::posint)) {
+               if (is_a<numeric>(x)) {
+                       return S_num(ex_to<numeric>(n).to_int(), ex_to<numeric>(p).to_int(), ex_to<numeric>(x));
+               } else {
+                       ex x_val = x.evalf();
+                       if (is_a<numeric>(x_val)) {
+                               return S_num(ex_to<numeric>(n).to_int(), ex_to<numeric>(p).to_int(), ex_to<numeric>(x_val));
+                       }
+               }
+       }
+       return this->hold();
+}
+
+ex S_function::pderivative(unsigned deriv_param) const
+{
+       const ex& n = seq[0];
+       const ex& p = seq[1];
+       const ex& x = seq[2];
+       GINAC_ASSERT(deriv_param < 3);
+       if (deriv_param < 2) {
+               return _ex0;
+       }
+       if (n > 0) {
+               return S(n-1, p, x) / x;
+       } else {
+               return S(n, p-1, x) / (1-x);
+       }
+}
+
+ex S_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& n = seq[0];
+       const ex& p = seq[1];
+       const ex& x = seq[2];
+       if (p == _ex1) {
+               return Li(n+1, x).series(rel, order, options);
+       }
+
+       const ex x_pt = x.subs(rel, subs_options::no_pattern);
+       if (n.info(info_flags::posint) && p.info(info_flags::posint) && x_pt.info(info_flags::numeric)) {
+               // First special case: x==0 (derivatives have poles)
+               if (x_pt.is_zero()) {
+                       const symbol s;
+                       ex ser;
+                       // manually construct the primitive expansion
+                       // subsum = Euler-Zagier-Sum is needed
+                       // dirty hack (slow ...) calculation of subsum:
+                       std::vector<ex> presubsum, subsum;
+                       subsum.push_back(0);
+                       for (int i=1; i<order-1; ++i) {
+                               subsum.push_back(subsum[i-1] + numeric(1, i));
+                       }
+                       for (int depth=2; depth<p; ++depth) {
+                               presubsum = subsum;
+                               for (int i=1; i<order-1; ++i) {
+                                       subsum[i] = subsum[i-1] + numeric(1, i) * presubsum[i-1];
+                               }
+                       }
+                               
+                       for (int i=1; i<order; ++i) {
+                               ser += pow(s,i) / pow(numeric(i), n+1) * subsum[i-1];
+                       }
+                       // substitute the argument's series expansion
+                       ser = ser.subs(s==x.series(rel, order), subs_options::no_pattern);
+                       // maybe that was terminating, so add a proper order term
+                       epvector nseq;
+                       nseq.push_back(expair(Order(_ex1), order));
+                       ser += pseries(rel, nseq);
+                       // reexpanding it will collapse the series again
+                       return ser.series(rel, order);
+               }
+               // TODO special cases: x==1 (branch point) and x real, >=1 (branch cut)
+               throw std::runtime_error("S_series: don't know how to do the series expansion at this point!");
+       }
+       // all other cases should be safe, by now:
+       return basic::series(rel, order, options);
+}
+
+void S_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       const ex& n = seq[0];
+       const ex& p = seq[1];
+       const ex& x = seq[2];
+       c.s << "\\mbox{S}_{";
+       n.print(c);
+       c.s << ",";
+       p.print(c);
+       c.s << "}(";
+       x.print(c);
+       c.s << ")";
+}
+
+//////////////////////////////////////////////////////////////////////
+//
+// Harmonic polylogarithm  H(m,x)
+//
+// helper functions
+//
+//////////////////////////////////////////////////////////////////////
+
+
+// anonymous namespace for helper functions
+namespace {
+
+       
+// regulates the pole (used by 1/x-transformation)
+symbol H_polesign("IMSIGN");
+
+
+// convert parameters from H to Li representation
+// parameters are expected to be in expanded form, i.e. only 0, 1 and -1
+// returns true if some parameters are negative
+bool convert_parameter_H_to_Li(const lst& l, lst& m, lst& s, ex& pf)
+{
+       // expand parameter list
+       lst mexp;
+       for (lst::const_iterator it = l.begin(); it != l.end(); it++) {
+               if (*it > 1) {
+                       for (ex count=*it-1; count > 0; count--) {
+                               mexp.append(0);
+                       }
+                       mexp.append(1);
+               } else if (*it < -1) {
+                       for (ex count=*it+1; count < 0; count++) {
+                               mexp.append(0);
+                       }
+                       mexp.append(-1);
+               } else {
+                       mexp.append(*it);
+               }
+       }
+       
+       ex signum = 1;
+       pf = 1;
+       bool has_negative_parameters = false;
+       ex acc = 1;
+       for (lst::const_iterator it = mexp.begin(); it != mexp.end(); it++) {
+               if (*it == 0) {
+                       acc++;
+                       continue;
+               }
+               if (*it > 0) {
+                       m.append((*it+acc-1) * signum);
+               } else {
+                       m.append((*it-acc+1) * signum);
+               }
+               acc = 1;
+               signum = *it;
+               pf *= *it;
+               if (pf < 0) {
+                       has_negative_parameters = true;
+               }
+       }
+       if (has_negative_parameters) {
+               for (int i=0; i<m.nops(); i++) {
+                       if (m.op(i) < 0) {
+                               m.let_op(i) = -m.op(i);
+                               s.append(-1);
+                       } else {
+                               s.append(1);
+                       }
+               }
+       }
+       
+       return has_negative_parameters;
+}
+
+
+// recursivly transforms H to corresponding multiple polylogarithms
+struct map_trafo_H_convert_to_Li : public map_function
+{
+       ex operator()(const ex& e)
+       {
+               if (is_a<add>(e) || is_a<mul>(e)) {
+                       return e.map(*this);
+               }
+               if (is_exactly_a<H_function>(e)) {
+                       lst parameter;
+                       if (is_a<lst>(e.op(0))) {
+                               parameter = ex_to<lst>(e.op(0));
+                       } else {
+                               parameter = lst(e.op(0));
+                       }
+                       ex arg = e.op(1);
+
+                       lst m;
+                       lst s;
+                       ex pf;
+                       if (convert_parameter_H_to_Li(parameter, m, s, pf)) {
+                               s.let_op(0) = s.op(0) * arg;
+                               return pf * Li(m, s).hold();
+                       } else {
+                               for (int i=0; i<m.nops(); i++) {
+                                       s.append(1);
+                               }
+                               s.let_op(0) = s.op(0) * arg;
+                               return Li(m, s).hold();
+                       }
+               }
+               return e;
+       }
+};
+
+
+// recursivly transforms H to corresponding zetas
+struct map_trafo_H_convert_to_zeta : public map_function
+{
+       ex operator()(const ex& e)
+       {
+               if (is_a<add>(e) || is_a<mul>(e)) {
+                       return e.map(*this);
+               }
+               if (is_exactly_a<H_function>(e)) {
+                       lst parameter;
+                       if (is_a<lst>(e.op(0))) {
+                               parameter = ex_to<lst>(e.op(0));
+                       } else {
+                               parameter = lst(e.op(0));
+                       }
+
+                       lst m;
+                       lst s;
+                       ex pf;
+                       if (convert_parameter_H_to_Li(parameter, m, s, pf)) {
+                               return pf * zeta(m, s);
+                       } else {
+                               return zeta(m);
+                       }
+               }
+               return e;
+       }
+};
+
+
+// remove trailing zeros from H-parameters
+struct map_trafo_H_reduce_trailing_zeros : public map_function
+{
+       ex operator()(const ex& e)
+       {
+               if (is_a<add>(e) || is_a<mul>(e)) {
+                       return e.map(*this);
+               }
+               if (is_exactly_a<H_function>(e)) {
+                       lst parameter;
+                       if (is_a<lst>(e.op(0))) {
+                               parameter = ex_to<lst>(e.op(0));
+                       } else {
+                               parameter = lst(e.op(0));
+                       }
+                       ex arg = e.op(1);
+                       if (parameter.op(parameter.nops()-1) == 0) {
+
+                               //
+                               if (parameter.nops() == 1) {
+                                       return log(arg);
+                               }
+
+                               //
+                               lst::const_iterator it = parameter.begin();
+                               while ((it != parameter.end()) && (*it == 0)) {
+                                       it++;
+                               }
+                               if (it == parameter.end()) {
+                                       return pow(log(arg),parameter.nops()) / factorial(parameter.nops());
+                               }
+
+                               //
+                               parameter.remove_last();
+                               int lastentry = parameter.nops();
+                               while ((lastentry > 0) && (parameter[lastentry-1] == 0)) {
+                                       lastentry--;
+                               }
+
+                               //
+                               ex result = log(arg) * H(parameter,arg).hold();
+                               ex acc = 0;
+                               for (ex i=0; i<lastentry; i++) {
+                                       if (parameter[i] > 0) {
+                                               parameter[i]++;
+                                               result -= (acc + parameter[i]-1) * H(parameter, arg).hold();
+                                               parameter[i]--;
+                                               acc = 0;
+                                       } else if (parameter[i] < 0) {
+                                               parameter[i]--;
+                                               result -= (acc + abs(parameter[i]+1)) * H(parameter, arg).hold();
+                                               parameter[i]++;
+                                               acc = 0;
+                                       } else {
+                                               acc++;
+                                       }
+                               }
+
+                               if (lastentry < parameter.nops()) {
+                                       result = result / (parameter.nops()-lastentry+1);
+                                       return result.map(*this);
+                               } else {
+                                       return result;
+                               }
+                       }
+               }
+               return e;
+       }
+};
+
+
+// returns an expression with zeta functions corresponding to the parameter list for H
+ex convert_H_to_zeta(const lst& m)
+{
+       symbol xtemp("xtemp");
+       map_trafo_H_reduce_trailing_zeros filter;
+       map_trafo_H_convert_to_zeta filter2;
+       return filter2(filter(H(m, xtemp).hold())).subs(xtemp == 1);
+}
+
+
+// convert signs form Li to H representation
+lst convert_parameter_Li_to_H(const lst& m, const lst& x, ex& pf)
+{
+       lst res;
+       lst::const_iterator itm = m.begin();
+       lst::const_iterator itx = ++x.begin();
+       int signum = 1;
+       pf = _ex1;
+       res.append(*itm);
+       itm++;
+       while (itx != x.end()) {
+               signum *= (*itx > 0) ? 1 : -1;
+               pf *= signum;
+               res.append((*itm) * signum);
+               itm++;
+               itx++;
+       }
+       return res;
+}
+
+
+// multiplies an one-dimensional H with another H
+// [ReV] (18)
+ex trafo_H_mult(const ex& h1, const ex& h2)
+{
+       ex res;
+       ex hshort;
+       lst hlong;
+       ex h1nops = h1.op(0).nops();
+       ex h2nops = h2.op(0).nops();
+       if (h1nops > 1) {
+               hshort = h2.op(0).op(0);
+               hlong = ex_to<lst>(h1.op(0));
+       } else {
+               hshort = h1.op(0).op(0);
+               if (h2nops > 1) {
+                       hlong = ex_to<lst>(h2.op(0));
+               } else {
+                       hlong = h2.op(0).op(0);
+               }
+       }
+       for (int i=0; i<=hlong.nops(); i++) {
+               lst newparameter;
+               int j=0;
+               for (; j<i; j++) {
+                       newparameter.append(hlong[j]);
+               }
+               newparameter.append(hshort);
+               for (; j<hlong.nops(); j++) {
+                       newparameter.append(hlong[j]);
+               }
+               res += H(newparameter, h1.op(1)).hold();
+       }
+       return res;
+}
+
+
+// applies trafo_H_mult recursively on expressions
+struct map_trafo_H_mult : public map_function
+{
+       ex operator()(const ex& e)
+       {
+               if (is_a<add>(e)) {
+                       return e.map(*this);
+               }
+
+               if (is_a<mul>(e)) {
+
+                       ex result = 1;
+                       ex firstH;
+                       lst Hlst;
+                       for (int pos=0; pos<e.nops(); pos++) {
+                               if (is_a<power>(e.op(pos)) && is_exactly_a<H_function>(e.op(pos).op(0))) {
+                                       for (ex i=0; i<e.op(pos).op(1); i++) {
+                                               Hlst.append(e.op(pos).op(0));
+                                       }
+                                       continue;
+                               } else if (is_exactly_a<H_function>(e.op(pos))) {
+                                       if (e.op(pos).op(0).nops() > 1) {
+                                               firstH = e.op(pos);
+                                       } else {
+                                               Hlst.append(e.op(pos));
+                                       }
+                                       continue;
+                               }
+                               result *= e.op(pos);
+                       }
+                       if (firstH == 0) {
+                               if (Hlst.nops() > 0) {
+                                       firstH = Hlst[Hlst.nops()-1];
+                                       Hlst.remove_last();
+                               } else {
+                                       return e;
+                               }
+                       }
+
+                       if (Hlst.nops() > 0) {
+                               ex buffer = trafo_H_mult(firstH, Hlst.op(0));
+                               result *= buffer;
+                               for (int i=1; i<Hlst.nops(); i++) {
+                                       result *= Hlst.op(i);
+                               }
+                               result = result.expand();
+                               map_trafo_H_mult recursion;
+                               return recursion(result);
+                       } else {
+                               return e;
+                       }
+
+               }
+               return e;
+       }
+};
+
+
+// do integration [ReV] (55)
+// put parameter 0 in front of existing parameters
+ex trafo_H_1tx_prepend_zero(const ex& e, const ex& arg)
+{
+       ex h;
+       std::string name;
+       if (is_exactly_a<H_function>(e)) {
+               h = e;
+       } else {
+               for (int i=0; i<e.nops(); i++) {
+                       if (is_exactly_a<H_function>(e.op(i))) {
+                               h = e.op(i);
+                       }
+               }
+       }
+       if (h != 0) {
+               lst newparameter = ex_to<lst>(h.op(0));
+               newparameter.prepend(0);
+               ex addzeta = convert_H_to_zeta(newparameter);
+               return e.subs(h == (addzeta-H(newparameter, h.op(1)).hold())).expand();
+       } else {
+               return e * (-H(lst(0),1/arg).hold());
+       }
+}
+
+
+// do integration [ReV] (49)
+// put parameter 1 in front of existing parameters
+ex trafo_H_prepend_one(const ex& e, const ex& arg)
+{
+       ex h;
+       std::string name;
+       if (is_exactly_a<H_function>(e)) {
+               h = e;
+       } else {
+               for (int i=0; i<e.nops(); i++) {
+                       if (is_exactly_a<H_function>(e.op(i))) {
+                               h = e.op(i);
+                       }
+               }
+       }
+       if (h != 0) {
+               lst newparameter = ex_to<lst>(h.op(0));
+               newparameter.prepend(1);
+               return e.subs(h == H(newparameter, h.op(1)).hold());
+       } else {
+               return e * H(lst(1),1-arg).hold();
+       }
+}
+
+
+// do integration [ReV] (55)
+// put parameter -1 in front of existing parameters
+ex trafo_H_1tx_prepend_minusone(const ex& e, const ex& arg)
+{
+       ex h;
+       std::string name;
+       if (is_exactly_a<H_function>(e)) {
+               h = e;
+       } else {
+               for (int i=0; i<e.nops(); i++) {
+                       if (is_exactly_a<H_function>(e.op(i))) {
+                               h = e.op(i);
+                       }
+               }
+       }
+       if (h != 0) {
+               lst newparameter = ex_to<lst>(h.op(0));
+               newparameter.prepend(-1);
+               ex addzeta = convert_H_to_zeta(newparameter);
+               return e.subs(h == (addzeta-H(newparameter, h.op(1)).hold())).expand();
+       } else {
+               ex addzeta = convert_H_to_zeta(lst(-1));
+               return (e * (addzeta - H(lst(-1),1/arg).hold())).expand();
+       }
+}
+
+
+// do integration [ReV] (55)
+// put parameter -1 in front of existing parameters
+ex trafo_H_1mxt1px_prepend_minusone(const ex& e, const ex& arg)
+{
+       ex h;
+       std::string name;
+       if (is_exactly_a<H_function>(e)) {
+               h = e;
+       } else {
+               for (int i=0; i<e.nops(); i++) {
+                       if (is_exactly_a<H_function>(e.op(i))) {
+                               h = e.op(i);
+                       }
+               }
+       }
+       if (h != 0) {
+               lst newparameter = ex_to<lst>(h.op(0));
+               newparameter.prepend(-1);
+               return e.subs(h == H(newparameter, h.op(1)).hold()).expand();
+       } else {
+               return (e * H(lst(-1),(1-arg)/(1+arg)).hold()).expand();
+       }
+}
+
+
+// do integration [ReV] (55)
+// put parameter 1 in front of existing parameters
+ex trafo_H_1mxt1px_prepend_one(const ex& e, const ex& arg)
+{
+       ex h;
+       std::string name;
+       if (is_exactly_a<H_function>(e)) {
+               h = e;
+       } else {
+               for (int i=0; i<e.nops(); i++) {
+                       if (is_exactly_a<H_function>(e.op(i))) {
+                               h = e.op(i);
+                       }
+               }
+       }
+       if (h != 0) {
+               lst newparameter = ex_to<lst>(h.op(0));
+               newparameter.prepend(1);
+               return e.subs(h == H(newparameter, h.op(1)).hold()).expand();
+       } else {
+               return (e * H(lst(1),(1-arg)/(1+arg)).hold()).expand();
+       }
+}
+
+
+// do x -> 1-x transformation
+struct map_trafo_H_1mx : public map_function
+{
+       ex operator()(const ex& e)
+       {
+               if (is_a<add>(e) || is_a<mul>(e)) {
+                       return e.map(*this);
+               }
+               
+               if (is_exactly_a<H_function>(e)) {
+
+                       lst parameter = ex_to<lst>(e.op(0));
+                       ex arg = e.op(1);
+
+                       // special cases if all parameters are either 0, 1 or -1
+                       bool allthesame = true;
+                       if (parameter.op(0) == 0) {
+                               for (int i=1; i<parameter.nops(); i++) {
+                                       if (parameter.op(i) != 0) {
+                                               allthesame = false;
+                                               break;
+                                       }
+                               }
+                               if (allthesame) {
+                                       lst newparameter;
+                                       for (int i=parameter.nops(); i>0; i--) {
+                                               newparameter.append(0);
+                                       }
+                                       return pow(-1, parameter.nops()) * H(newparameter, 1-arg).hold();
+                               }
+                       } else if (parameter.op(0) == -1) {
+                               throw std::runtime_error("map_trafo_H_1mx: cannot handle weights equal -1!");
+                       } else {
+                               for (int i=1; i<parameter.nops(); i++) {
+                                       if (parameter.op(i) != 1) {
+                                               allthesame = false;
+                                               break;
+                                       }
+                               }
+                               if (allthesame) {
+                                       lst newparameter;
+                                       for (int i=parameter.nops(); i>0; i--) {
+                                               newparameter.append(1);
+                                       }
+                                       return pow(-1, parameter.nops()) * H(newparameter, 1-arg).hold();
+                               }
+                       }
+
+                       lst newparameter = parameter;
+                       newparameter.remove_first();
+
+                       if (parameter.op(0) == 0) {
+
+                               // leading zero
+                               ex res = convert_H_to_zeta(parameter);
+                               //ex res = convert_from_RV(parameter, 1).subs(H(wild(1),wild(2))==zeta(wild(1)));
+                               map_trafo_H_1mx recursion;
+                               ex buffer = recursion(H(newparameter, arg).hold());
+                               if (is_a<add>(buffer)) {
+                                       for (int i=0; i<buffer.nops(); i++) {
+                                               res -= trafo_H_prepend_one(buffer.op(i), arg);
+                                       }
+                               } else {
+                                       res -= trafo_H_prepend_one(buffer, arg);
+                               }
+                               return res;
+
+                       } else {
+
+                               // leading one
+                               map_trafo_H_1mx recursion;
+                               map_trafo_H_mult unify;
+                               ex res;
+                               int firstzero = 0;
+                               while (parameter.op(firstzero) == 1) {
+                                       firstzero++;
+                               }
+                               for (int i=firstzero-1; i<parameter.nops()-1; i++) {
+                                       lst newparameter;
+                                       int j=0;
+                                       for (; j<=i; j++) {
+                                               newparameter.append(parameter[j+1]);
+                                       }
+                                       newparameter.append(1);
+                                       for (; j<parameter.nops()-1; j++) {
+                                               newparameter.append(parameter[j+1]);
+                                       }
+                                       res -= H(newparameter, arg).hold();
+                               }
+                               return (unify((-H(lst(0), 1-arg).hold() * recursion(H(newparameter, arg).hold())).expand()) +
+                                               recursion(res)) / firstzero;
+
+                       }
+               }
+               return e;
+       }
+};
+
+
+// do x -> 1/x transformation
+struct map_trafo_H_1overx : public map_function
+{
+       ex operator()(const ex& e)
+       {
+               if (is_a<add>(e) || is_a<mul>(e)) {
+                       return e.map(*this);
+               }
+
+               if (is_exactly_a<H_function>(e)) {
+
+                       lst parameter = ex_to<lst>(e.op(0));
+                       ex arg = e.op(1);
+
+                       // special cases if all parameters are either 0, 1 or -1
+                       bool allthesame = true;
+                       if (parameter.op(0) == 0) {
+                               for (int i=1; i<parameter.nops(); i++) {
+                                       if (parameter.op(i) != 0) {
+                                               allthesame = false;
+                                               break;
+                                       }
+                               }
+                               if (allthesame) {
+                                       return pow(-1, parameter.nops()) * H(parameter, 1/arg).hold();
+                               }
+                       } else if (parameter.op(0) == -1) {
+                               for (int i=1; i<parameter.nops(); i++) {
+                                       if (parameter.op(i) != -1) {
+                                               allthesame = false;
+                                               break;
+                                       }
+                               }
+                               if (allthesame) {
+                                       map_trafo_H_mult unify;
+                                       return unify((pow(H(lst(-1),1/arg).hold() - H(lst(0),1/arg).hold(), parameter.nops())
+                                                               / factorial(parameter.nops())).expand());
+                               }
+                       } else {
+                               for (int i=1; i<parameter.nops(); i++) {
+                                       if (parameter.op(i) != 1) {
+                                               allthesame = false;
+                                               break;
+                                       }
+                               }
+                               if (allthesame) {
+                                       map_trafo_H_mult unify;
+                                       return unify((pow(H(lst(1),1/arg).hold() + H(lst(0),1/arg).hold() + H_polesign, parameter.nops())
+                                                               / factorial(parameter.nops())).expand());
+                               }
+                       }
+
+                       lst newparameter = parameter;
+                       newparameter.remove_first();
+
+                       if (parameter.op(0) == 0) {
+
+                               // leading zero
+                               ex res = convert_H_to_zeta(parameter);
+                               map_trafo_H_1overx recursion;
+                               ex buffer = recursion(H(newparameter, arg).hold());
+                               if (is_a<add>(buffer)) {
+                                       for (int i=0; i<buffer.nops(); i++) {
+                                               res += trafo_H_1tx_prepend_zero(buffer.op(i), arg);
+                                       }
+                               } else {
+                                       res += trafo_H_1tx_prepend_zero(buffer, arg);
+                               }
+                               return res;
+
+                       } else if (parameter.op(0) == -1) {
+
+                               // leading negative one
+                               ex res = convert_H_to_zeta(parameter);
+                               map_trafo_H_1overx recursion;
+                               ex buffer = recursion(H(newparameter, arg).hold());
+                               if (is_a<add>(buffer)) {
+                                       for (int i=0; i<buffer.nops(); i++) {
+                                               res += trafo_H_1tx_prepend_zero(buffer.op(i), arg) - trafo_H_1tx_prepend_minusone(buffer.op(i), arg);
+                                       }
+                               } else {
+                                       res += trafo_H_1tx_prepend_zero(buffer, arg) - trafo_H_1tx_prepend_minusone(buffer, arg);
+                               }
+                               return res;
+
+                       } else {
+
+                               // leading one
+                               map_trafo_H_1overx recursion;
+                               map_trafo_H_mult unify;
+                               ex res = H(lst(1), arg).hold() * H(newparameter, arg).hold();
+                               int firstzero = 0;
+                               while (parameter.op(firstzero) == 1) {
+                                       firstzero++;
+                               }
+                               for (int i=firstzero-1; i<parameter.nops()-1; i++) {
+                                       lst newparameter;
+                                       int j=0;
+                                       for (; j<=i; j++) {
+                                               newparameter.append(parameter[j+1]);
+                                       }
+                                       newparameter.append(1);
+                                       for (; j<parameter.nops()-1; j++) {
+                                               newparameter.append(parameter[j+1]);
+                                       }
+                                       res -= H(newparameter, arg).hold();
+                               }
+                               res = recursion(res).expand() / firstzero;
+                               return unify(res);
+
+                       }
+               }
+               return e;
+       }
+};
+
+
+// do x -> (1-x)/(1+x) transformation
+struct map_trafo_H_1mxt1px : public map_function
+{
+       ex operator()(const ex& e)
+       {
+               if (is_a<add>(e) || is_a<mul>(e)) {
+                       return e.map(*this);
+               }
+
+               if (is_exactly_a<H_function>(e)) {
+
+                       lst parameter = ex_to<lst>(e.op(0));
+                       ex arg = e.op(1);
+
+                       // special cases if all parameters are either 0, 1 or -1
+                       bool allthesame = true;
+                       if (parameter.op(0) == 0) {
+                               for (int i=1; i<parameter.nops(); i++) {
+                                       if (parameter.op(i) != 0) {
+                                               allthesame = false;
+                                               break;
+                                       }
+                               }
+                               if (allthesame) {
+                                       map_trafo_H_mult unify;
+                                       ex res = unify((pow(-H(lst(1),(1-arg)/(1+arg)).hold() - H(lst(-1),(1-arg)/(1+arg)).hold(), parameter.nops())
+                                                               / factorial(parameter.nops())).expand());
+                                       return res;
+                               }
+                       } else if (parameter.op(0) == -1) {
+                               for (int i=1; i<parameter.nops(); i++) {
+                                       if (parameter.op(i) != -1) {
+                                               allthesame = false;
+                                               break;
+                                       }
+                               }
+                               if (allthesame) {
+                                       map_trafo_H_mult unify;
+                                       ex res = unify((pow(log(2) - H(lst(-1),(1-arg)/(1+arg)).hold(), parameter.nops())
+                                                               / factorial(parameter.nops())).expand());
+                                       return res;
+                               }
+                       } else {
+                               for (int i=1; i<parameter.nops(); i++) {
+                                       if (parameter.op(i) != 1) {
+                                               allthesame = false;
+                                               break;
+                                       }
+                               }
+                               if (allthesame) {
+                                       map_trafo_H_mult unify;
+                                       ex res = unify((pow(-log(2) - H(lst(0),(1-arg)/(1+arg)).hold() + H(lst(-1),(1-arg)/(1+arg)).hold(), parameter.nops())
+                                                               / factorial(parameter.nops())).expand());
+                                       return res;
+                               }
+                       }
+
+                       lst newparameter = parameter;
+                       newparameter.remove_first();
+
+                       if (parameter.op(0) == 0) {
+
+                               // leading zero
+                               ex res = convert_H_to_zeta(parameter);
+                               map_trafo_H_1mxt1px recursion;
+                               ex buffer = recursion(H(newparameter, arg).hold());
+                               if (is_a<add>(buffer)) {
+                                       for (int i=0; i<buffer.nops(); i++) {
+                                               res -= trafo_H_1mxt1px_prepend_one(buffer.op(i), arg) + trafo_H_1mxt1px_prepend_minusone(buffer.op(i), arg);
+                                       }
+                               } else {
+                                       res -= trafo_H_1mxt1px_prepend_one(buffer, arg) + trafo_H_1mxt1px_prepend_minusone(buffer, arg);
+                               }
+                               return res;
+
+                       } else if (parameter.op(0) == -1) {
+
+                               // leading negative one
+                               ex res = convert_H_to_zeta(parameter);
+                               map_trafo_H_1mxt1px recursion;
+                               ex buffer = recursion(H(newparameter, arg).hold());
+                               if (is_a<add>(buffer)) {
+                                       for (int i=0; i<buffer.nops(); i++) {
+                                               res -= trafo_H_1mxt1px_prepend_minusone(buffer.op(i), arg);
+                                       }
+                               } else {
+                                       res -= trafo_H_1mxt1px_prepend_minusone(buffer, arg);
+                               }
+                               return res;
+
+                       } else {
+
+                               // leading one
+                               map_trafo_H_1mxt1px recursion;
+                               map_trafo_H_mult unify;
+                               ex res = H(lst(1), arg).hold() * H(newparameter, arg).hold();
+                               int firstzero = 0;
+                               while (parameter.op(firstzero) == 1) {
+                                       firstzero++;
+                               }
+                               for (int i=firstzero-1; i<parameter.nops()-1; i++) {
+                                       lst newparameter;
+                                       int j=0;
+                                       for (; j<=i; j++) {
+                                               newparameter.append(parameter[j+1]);
+                                       }
+                                       newparameter.append(1);
+                                       for (; j<parameter.nops()-1; j++) {
+                                               newparameter.append(parameter[j+1]);
+                                       }
+                                       res -= H(newparameter, arg).hold();
+                               }
+                               res = recursion(res).expand() / firstzero;
+                               res = unify(res);
+                               return res;
+
+                       }
+               }
+               return e;
+       }
+};
+
+
+// do the actual summation.
+cln::cl_N H_do_sum(const std::vector<int>& m, const cln::cl_N& x)
+{
+       const int j = m.size();
+
+       std::vector<cln::cl_N> t(j);
+
+       cln::cl_F one = cln::cl_float(1, cln::float_format(Digits));
+       cln::cl_N factor = cln::expt(x, j) * one;
+       cln::cl_N t0buf;
+       int q = 0;
+       do {
+               t0buf = t[0];
+               q++;
+               t[j-1] = t[j-1] + 1 / cln::expt(cln::cl_I(q),m[j-1]);
+               for (int k=j-2; k>=1; k--) {
+                       t[k] = t[k] + t[k+1] / cln::expt(cln::cl_I(q+j-1-k), m[k]);
+               }
+               t[0] = t[0] + t[1] * factor / cln::expt(cln::cl_I(q+j-1), m[0]);
+               factor = factor * x;
+       } while (t[0] != t0buf);
+
+       return t[0];
+}
+
+
+} // end of anonymous namespace
+
+
+//////////////////////////////////////////////////////////////////////
+//
+// Harmonic polylogarithm  H(m,x)
+//
+// GiNaC function
+//
+//////////////////////////////////////////////////////////////////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(H_function,
+               print_func<print_latex>(&H_function::do_print_latex))
+
+ex H_function::eval(int level) const
+{
+       if (!do_eval) return this->hold();
+       
+       const ex& m_ = seq[0];
+       const ex& x = seq[1];
+       lst m;
+       if (is_a<lst>(m_)) {
+               m = ex_to<lst>(m_);
+       } else {
+               m = lst(m_);
+       }
+       if (m.nops() == 0) {
+               return _ex1;
+       }
+       ex pos1;
+       ex pos2;
+       ex n;
+       ex p;
+       int step = 0;
+       if (*m.begin() > _ex1) {
+               step++;
+               pos1 = _ex0;
+               pos2 = _ex1;
+               n = *m.begin()-1;
+               p = _ex1;
+       } else if (*m.begin() < _ex_1) {
+               step++;
+               pos1 = _ex0;
+               pos2 = _ex_1;
+               n = -*m.begin()-1;
+               p = _ex1;
+       } else if (*m.begin() == _ex0) {
+               pos1 = _ex0;
+               n = _ex1;
+       } else {
+               pos1 = *m.begin();
+               p = _ex1;
+       }
+       for (lst::const_iterator it = ++m.begin(); it != m.end(); it++) {
+               if ((*it).info(info_flags::integer)) {
+                       if (step == 0) {
+                               if (*it > _ex1) {
+                                       if (pos1 == _ex0) {
+                                               step = 1;
+                                               pos2 = _ex1;
+                                               n += *it-1;
+                                               p = _ex1;
+                                       } else {
+                                               step = 2;
+                                       }
+                               } else if (*it < _ex_1) {
+                                       if (pos1 == _ex0) {
+                                               step = 1;
+                                               pos2 = _ex_1;
+                                               n += -*it-1;
+                                               p = _ex1;
+                                       } else {
+                                               step = 2;
+                                       }
+                               } else {
+                                       if (*it != pos1) {
+                                               step = 1;
+                                               pos2 = *it;
+                                       }
+                                       if (*it == _ex0) {
+                                               n++;
+                                       } else {
+                                               p++;
+                                       }
+                               }
+                       } else if (step == 1) {
+                               if (*it != pos2) {
+                                       step = 2;
+                               } else {
+                                       if (*it == _ex0) {
+                                               n++;
+                                       } else {
+                                               p++;
+                                       }
+                               }
+                       }
+               } else {
+                       // if some m_i is not an integer
+                       return this->hold();
+               }
+       }
+       if ((x == _ex1) && (*(--m.end()) != _ex0)) {
+               return convert_H_to_zeta(m);
+       }
+       if (step == 0) {
+               if (pos1 == _ex0) {
+                       // all zero
+                       if (x == _ex0) {
+                               return this->hold();
+                       }
+                       return pow(log(x), m.nops()) / factorial(m.nops());
+               } else {
+                       // all (minus) one
+                       return pow(-pos1*log(1-pos1*x), m.nops()) / factorial(m.nops());
+               }
+       } else if ((step == 1) && (pos1 == _ex0)){
+               // convertible to S
+               if (pos2 == _ex1) {
+                       return S(n, p, x);
+               } else {
+                       return pow(-1, p) * S(n, p, -x);
+               }
+       }
+       if (x == _ex0) {
+               return _ex0;
+       }
+       if (x.info(info_flags::numeric) && (!x.info(info_flags::crational))) {
+               return evalf(level);
+       }
+       return this->hold();
+}
+
+ex H_function::evalf(int level) const
+{
+       const ex& x1 = seq[0];
+       const ex& x2 = seq[1];
+       if (is_a<lst>(x1)) {
+               
+               cln::cl_N x;
+               if (is_a<numeric>(x2)) {
+                       x = ex_to<numeric>(x2).to_cl_N();
+               } else {
+                       ex x2_val = x2.evalf();
+                       if (is_a<numeric>(x2_val)) {
+                               x = ex_to<numeric>(x2_val).to_cl_N();
+                       }
+               }
+
+               for (int i=0; i<x1.nops(); i++) {
+                       if (!x1.op(i).info(info_flags::integer)) {
+                               return this->hold();
+                       }
+               }
+               if (x1.nops() < 1) {
+                       return this->hold();
+               }
+
+               const lst& morg = ex_to<lst>(x1);
+               // remove trailing zeros ...
+               if (*(--morg.end()) == 0) {
+                       symbol xtemp("xtemp");
+                       map_trafo_H_reduce_trailing_zeros filter;
+                       return filter(H(x1, xtemp).hold()).subs(xtemp==x2).evalf();
+               }
+               // ... and expand parameter notation
+               bool has_minus_one = false;
+               lst m;
+               for (lst::const_iterator it = morg.begin(); it != morg.end(); it++) {
+                       if (*it > 1) {
+                               for (ex count=*it-1; count > 0; count--) {
+                                       m.append(0);
+                               }
+                               m.append(1);
+                       } else if (*it <= -1) {
+                               for (ex count=*it+1; count < 0; count++) {
+                                       m.append(0);
+                               }
+                               m.append(-1);
+                               has_minus_one = true;
+                       } else {
+                               m.append(*it);
+                       }
+               }
+
+               // do summation
+               if (cln::abs(x) < 0.95) {
+       
+                       lst m_lst;
+                       lst s_lst;
+                       ex pf;
+                       if (convert_parameter_H_to_Li(m, m_lst, s_lst, pf)) {
+                               // negative parameters -> s_lst is filled
+                               std::vector<int> m_int;
+                               std::vector<cln::cl_N> x_cln;
+                               for (lst::const_iterator it_int = m_lst.begin(), it_cln = s_lst.begin(); 
+                                    it_int != m_lst.end(); it_int++, it_cln++) {
+                                       m_int.push_back(ex_to<numeric>(*it_int).to_int());
+                                       x_cln.push_back(ex_to<numeric>(*it_cln).to_cl_N());
+                               }
+                               x_cln.front() = x_cln.front() * x;
+                               return pf * numeric(multipleLi_do_sum(m_int, x_cln));
+                       } else {
+                               // only positive parameters
+                               //TODO
+                               if (m_lst.nops() == 1) {
+                                       return Li(m_lst.op(0), x2).evalf();
+                               }
+                               std::vector<int> m_int;
+                               for (lst::const_iterator it = m_lst.begin(); it != m_lst.end(); it++) {
+                                       m_int.push_back(ex_to<numeric>(*it).to_int());
+                               }
+                               return numeric(H_do_sum(m_int, x));
+                       }
+               }
+
+               symbol xtemp("xtemp");
+               ex res = 1;     
+               
+               // ensure that the realpart of the argument is positive
+               if (cln::realpart(x) < 0) {
+                       x = -x;
+                       for (int i=0; i<m.nops(); i++) {
+                               if (m.op(i) != 0) {
+                                       m.let_op(i) = -m.op(i);
+                                       res *= -1;
+                               }
+                       }
+               }
+
+               // x -> 1/x
+               if (cln::abs(x) >= 2.0) {
+                       map_trafo_H_1overx trafo;
+                       res *= trafo(H(m, xtemp));
+                       if (cln::imagpart(x) <= 0) {
+                               res = res.subs(H_polesign == -I*Pi);
+                       } else {
+                               res = res.subs(H_polesign == I*Pi);
+                       }
+                       return res.subs(xtemp == numeric(x)).evalf();
+               }
+               
+               // check transformations for 0.95 <= |x| < 2.0
+               
+               // |(1-x)/(1+x)| < 0.9 -> circular area with center=9,53+0i and radius=9.47
+               if (cln::abs(x-9.53) <= 9.47) {
+                       // x -> (1-x)/(1+x)
+                       map_trafo_H_1mxt1px trafo;
+                       res *= trafo(H(m, xtemp));
+               } else {
+                       // x -> 1-x
+                       if (has_minus_one) {
+                               map_trafo_H_convert_to_Li filter;
+                               return filter(H(m, numeric(x)).hold()).evalf();
+                       }
+                       map_trafo_H_1mx trafo;
+                       res *= trafo(H(m, xtemp));
+               }
+
+               return res.subs(xtemp == numeric(x)).evalf();
+       }
+
+       return this->hold();
+}
+
+ex H_function::pderivative(unsigned deriv_param) const
+{
+       const ex& m_ = seq[0];
+       const ex& x = seq[1];
+       GINAC_ASSERT(deriv_param < 2);
+       if (deriv_param == 0) {
+               return _ex0;
+       }
+       lst m;
+       if (is_a<lst>(m_)) {
+               m = ex_to<lst>(m_);
+       } else {
+               m = lst(m_);
+       }
+       ex mb = *m.begin();
+       if (mb > _ex1) {
+               m[0]--;
+               return H(m, x) / x;
+       }
+       if (mb < _ex_1) {
+               m[0]++;
+               return H(m, x) / x;
+       }
+       m.remove_first();
+       if (mb == _ex1) {
+               return 1/(1-x) * H(m, x);
+       } else if (mb == _ex_1) {
+               return 1/(1+x) * H(m, x);
+       } else {
+               return H(m, x) / x;
+       }
+}
+
+bool H_function::do_eval = true;
+
+ex H_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& m = seq[0];
+       const ex& x = seq[1];
+       epvector seq;
+       seq.push_back(expair(H(m, x), 0));
+       return pseries(rel, seq);
+}
+
+void H_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       const ex& m_ = seq[0];
+       const ex& x = seq[1];
+       lst m;
+       if (is_a<lst>(m_)) {
+               m = ex_to<lst>(m_);
+       } else {
+               m = lst(m_);
+       }
+       c.s << "\\mbox{H}_{";
+       lst::const_iterator itm = m.begin();
+       (*itm).print(c);
+       itm++;
+       for (; itm != m.end(); itm++) {
+               c.s << ",";
+               (*itm).print(c);
+       }
+       c.s << "}(";
+       x.print(c);
+       c.s << ")";
+}
+
+// takes a parameter list for H and returns an expression with corresponding multiple polylogarithms
+ex convert_H_to_Li(const ex& m, const ex& x)
+{
+       map_trafo_H_reduce_trailing_zeros filter;
+       map_trafo_H_convert_to_Li filter2;
+       if (is_a<lst>(m)) {
+               return filter2(filter(H(m, x).hold()));
+       } else {
+               return filter2(filter(H(lst(m), x).hold()));
+       }
+}
+
+//////////////////////////////////////////////////////////////////////
+//
+// Multiple zeta values  zeta(x) and zeta(x,s)
+//
+// helper functions
+//
+//////////////////////////////////////////////////////////////////////
+
+
+// anonymous namespace for helper functions
+namespace {
+
+
+// parameters and data for [Cra] algorithm
+const cln::cl_N lambda = cln::cl_N("319/320");
+int L1;
+int L2;
+std::vector<std::vector<cln::cl_N> > f_kj;
+std::vector<cln::cl_N> crB;
+std::vector<std::vector<cln::cl_N> > crG;
+std::vector<cln::cl_N> crX;
+
+
+void halfcyclic_convolute(const std::vector<cln::cl_N>& a, const std::vector<cln::cl_N>& b, std::vector<cln::cl_N>& c)
+{
+       const int size = a.size();
+       for (int n=0; n<size; n++) {
+               c[n] = 0;
+               for (int m=0; m<=n; m++) {
+                       c[n] = c[n] + a[m]*b[n-m];
+               }
+       }
+}
+
+
+// [Cra] section 4
+void initcX(const std::vector<int>& s)
+{
+       const int k = s.size();
+
+       crX.clear();
+       crG.clear();
+       crB.clear();
+
+       for (int i=0; i<=L2; i++) {
+               crB.push_back(bernoulli(i).to_cl_N() / cln::factorial(i));
+       }
+
+       int Sm = 0;
+       int Smp1 = 0;
+       for (int m=0; m<k-1; m++) {
+               std::vector<cln::cl_N> crGbuf;
+               Sm = Sm + s[m];
+               Smp1 = Sm + s[m+1];
+               for (int i=0; i<=L2; i++) {
+                       crGbuf.push_back(cln::factorial(i + Sm - m - 2) / cln::factorial(i + Smp1 - m - 2));
+               }
+               crG.push_back(crGbuf);
+       }
+
+       crX = crB;
+
+       for (int m=0; m<k-1; m++) {
+               std::vector<cln::cl_N> Xbuf;
+               for (int i=0; i<=L2; i++) {
+                       Xbuf.push_back(crX[i] * crG[m][i]);
+               }
+               halfcyclic_convolute(Xbuf, crB, crX);
+       }
+}
+
+
+// [Cra] section 4
+cln::cl_N crandall_Y_loop(const cln::cl_N& Sqk)
+{
+       cln::cl_F one = cln::cl_float(1, cln::float_format(Digits));
+       cln::cl_N factor = cln::expt(lambda, Sqk);
+       cln::cl_N res = factor / Sqk * crX[0] * one;
+       cln::cl_N resbuf;
+       int N = 0;
+       do {
+               resbuf = res;
+               factor = factor * lambda;
+               N++;
+               res = res + crX[N] * factor / (N+Sqk);
+       } while ((res != resbuf) || cln::zerop(crX[N]));
+       return res;
+}
+
+
+// [Cra] section 4
+void calc_f(int maxr)
+{
+       f_kj.clear();
+       f_kj.resize(L1);
+       
+       cln::cl_N t0, t1, t2, t3, t4;
+       int i, j, k;
+       std::vector<std::vector<cln::cl_N> >::iterator it = f_kj.begin();
+       cln::cl_F one = cln::cl_float(1, cln::float_format(Digits));
+       
+       t0 = cln::exp(-lambda);
+       t2 = 1;
+       for (k=1; k<=L1; k++) {
+               t1 = k * lambda;
+               t2 = t0 * t2;
+               for (j=1; j<=maxr; j++) {
+                       t3 = 1;
+                       t4 = 1;
+                       for (i=2; i<=j; i++) {
+                               t4 = t4 * (j-i+1);
+                               t3 = t1 * t3 + t4;
+                       }
+                       (*it).push_back(t2 * t3 * cln::expt(cln::cl_I(k),-j) * one);
+               }
+               it++;
+       }
+}
+
+
+// [Cra] (3.1)
+cln::cl_N crandall_Z(const std::vector<int>& s)
+{
+       const int j = s.size();
+
+       if (j == 1) {   
+               cln::cl_N t0;
+               cln::cl_N t0buf;
+               int q = 0;
+               do {
+                       t0buf = t0;
+                       q++;
+                       t0 = t0 + f_kj[q+j-2][s[0]-1];
+               } while (t0 != t0buf);
+               
+               return t0 / cln::factorial(s[0]-1);
+       }
+
+       std::vector<cln::cl_N> t(j);
+
+       cln::cl_N t0buf;
+       int q = 0;
+       do {
+               t0buf = t[0];
+               q++;
+               t[j-1] = t[j-1] + 1 / cln::expt(cln::cl_I(q),s[j-1]);
+               for (int k=j-2; k>=1; k--) {
+                       t[k] = t[k] + t[k+1] / cln::expt(cln::cl_I(q+j-1-k), s[k]);
+               }
+               t[0] = t[0] + t[1] * f_kj[q+j-2][s[0]-1];
+       } while (t[0] != t0buf);
+       
+       return t[0] / cln::factorial(s[0]-1);
+}
+
+
+// [Cra] (2.4)
+cln::cl_N zeta_do_sum_Crandall(const std::vector<int>& s)
+{
+       std::vector<int> r = s;
+       const int j = r.size();
+
+       // decide on maximal size of f_kj for crandall_Z
+       if (Digits < 50) {
+               L1 = 150;
+       } else {
+               L1 = Digits * 3 + j*2;
+       }
+
+       // decide on maximal size of crX for crandall_Y
+       if (Digits < 38) {
+               L2 = 63;
+       } else if (Digits < 86) {
+               L2 = 127;
+       } else if (Digits < 192) {
+               L2 = 255;
+       } else if (Digits < 394) {
+               L2 = 511;
+       } else if (Digits < 808) {
+               L2 = 1023;
+       } else {
+               L2 = 2047;
+       }
+
+       cln::cl_N res;
+
+       int maxr = 0;
+       int S = 0;
+       for (int i=0; i<j; i++) {
+               S += r[i];
+               if (r[i] > maxr) {
+                       maxr = r[i];
+               }
+       }
+
+       calc_f(maxr);
+
+       const cln::cl_N r0factorial = cln::factorial(r[0]-1);
+
+       std::vector<int> rz;
+       int skp1buf;
+       int Srun = S;
+       for (int k=r.size()-1; k>0; k--) {
+
+               rz.insert(rz.begin(), r.back());
+               skp1buf = rz.front();
+               Srun -= skp1buf;
+               r.pop_back();
+
+               initcX(r);
+               
+               for (int q=0; q<skp1buf; q++) {
+                       
+                       cln::cl_N pp1 = crandall_Y_loop(Srun+q-k);
+                       cln::cl_N pp2 = crandall_Z(rz);
+
+                       rz.front()--;
+                       
+                       if (q & 1) {
+                               res = res - pp1 * pp2 / cln::factorial(q);
+                       } else {
+                               res = res + pp1 * pp2 / cln::factorial(q);
+                       }
+               }
+               rz.front() = skp1buf;
+       }
+       rz.insert(rz.begin(), r.back());
+
+       initcX(rz);
+
+       res = (res + crandall_Y_loop(S-j)) / r0factorial + crandall_Z(rz);
+
+       return res;
+}
+
+
+cln::cl_N zeta_do_sum_simple(const std::vector<int>& r)
+{
+       const int j = r.size();
+
+       // buffer for subsums
+       std::vector<cln::cl_N> t(j);
+       cln::cl_F one = cln::cl_float(1, cln::float_format(Digits));
+
+       cln::cl_N t0buf;
+       int q = 0;
+       do {
+               t0buf = t[0];
+               q++;
+               t[j-1] = t[j-1] + one / cln::expt(cln::cl_I(q),r[j-1]);
+               for (int k=j-2; k>=0; k--) {
+                       t[k] = t[k] + one * t[k+1] / cln::expt(cln::cl_I(q+j-1-k), r[k]);
+               }
+       } while (t[0] != t0buf);
+
+       return t[0];
+}
+
+
+// does Hoelder convolution. see [BBB] (7.0)
+cln::cl_N zeta_do_Hoelder_convolution(const std::vector<int>& m_, const std::vector<int>& s_)
+{
+       // prepare parameters
+       // holds Li arguments in [BBB] notation
+       std::vector<int> s = s_;
+       std::vector<int> m_p = m_;
+       std::vector<int> m_q;
+       // holds Li arguments in nested sums notation
+       std::vector<cln::cl_N> s_p(s.size(), cln::cl_N(1));
+       s_p[0] = s_p[0] * cln::cl_N("1/2");
+       // convert notations
+       int sig = 1;
+       for (int i=0; i<s_.size(); i++) {
+               if (s_[i] < 0) {
+                       sig = -sig;
+                       s_p[i] = -s_p[i];
+               }
+               s[i] = sig * std::abs(s[i]);
+       }
+       std::vector<cln::cl_N> s_q;
+       cln::cl_N signum = 1;
+
+       // first term
+       cln::cl_N res = multipleLi_do_sum(m_p, s_p);
+
+       // middle terms
+       do {
+
+               // change parameters
+               if (s.front() > 0) {
+                       if (m_p.front() == 1) {
+                               m_p.erase(m_p.begin());
+                               s_p.erase(s_p.begin());
+                               if (s_p.size() > 0) {
+                                       s_p.front() = s_p.front() * cln::cl_N("1/2");
+                               }
+                               s.erase(s.begin());
+                               m_q.front()++;
+                       } else {
+                               m_p.front()--;
+                               m_q.insert(m_q.begin(), 1);
+                               if (s_q.size() > 0) {
+                                       s_q.front() = s_q.front() * 2;
+                               }
+                               s_q.insert(s_q.begin(), cln::cl_N("1/2"));
+                       }
+               } else {
+                       if (m_p.front() == 1) {
+                               m_p.erase(m_p.begin());
+                               cln::cl_N spbuf = s_p.front();
+                               s_p.erase(s_p.begin());
+                               if (s_p.size() > 0) {
+                                       s_p.front() = s_p.front() * spbuf;
+                               }
+                               s.erase(s.begin());
+                               m_q.insert(m_q.begin(), 1);
+                               if (s_q.size() > 0) {
+                                       s_q.front() = s_q.front() * 4;
+                               }
+                               s_q.insert(s_q.begin(), cln::cl_N("1/4"));
+                               signum = -signum;
+                       } else {
+                               m_p.front()--;
+                               m_q.insert(m_q.begin(), 1);
+                               if (s_q.size() > 0) {
+                                       s_q.front() = s_q.front() * 2;
+                               }
+                               s_q.insert(s_q.begin(), cln::cl_N("1/2"));
+                       }
+               }
+
+               // exiting the loop
+               if (m_p.size() == 0) break;
+
+               res = res + signum * multipleLi_do_sum(m_p, s_p) * multipleLi_do_sum(m_q, s_q);
+
+       } while (true);
+
+       // last term
+       res = res + signum * multipleLi_do_sum(m_q, s_q);
+
+       return res;
+}
+
+
+} // end of anonymous namespace
+
+
+//////////////////////////////////////////////////////////////////////
+//
+// Multiple zeta values   zeta(x)
+// Alternating Euler sum  zeta(x,s)
+//
+// GiNaC function
+//
+//////////////////////////////////////////////////////////////////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(zeta_function,
+               print_func<print_latex>(&zeta_function::do_print_latex))
+
+ex zeta_function::eval(int level) const
+{
+       if (seq.size() == 1) {
+               // zeta1
+               const ex& m = seq[0];
+               if (is_exactly_a<lst>(m)) {
+                       if (m.nops() == 1) {
+                               return zeta(m.op(0));
+                       }
+                       return this->hold();
+               }
+
+               if (m.info(info_flags::numeric)) {
+                       const numeric& y = ex_to<numeric>(m);
+                       // trap integer arguments:
+                       if (y.is_integer()) {
+                               if (y.is_zero()) {
+                                       return _ex_1_2;
+                               }
+                               if (y.is_equal(*_num1_p)) {
+                                       return this->hold();
+                               }
+                               if (y.info(info_flags::posint)) {
+                                       if (y.info(info_flags::odd)) {
+                                               return this->hold();
+                                       } else {
+                                               return abs(bernoulli(y)) * pow(Pi, y) * pow(*_num2_p, y-(*_num1_p)) / factorial(y);
+                                       }
+                               } else {
+                                       if (y.info(info_flags::odd)) {
+                                               return -bernoulli((*_num1_p)-y) / ((*_num1_p)-y);
+                                       } else {
+                                               return _ex0;
+                                       }
+                               }
+                       }
+                       // zeta(float)
+                       if (y.info(info_flags::numeric) && !y.info(info_flags::crational)) {
+                               return zeta(m).evalf();
+                       }
+               }
+               return zeta(m).hold();
+       } else {
+               // zeta 2
+               const ex& m = seq[0];
+               const ex& s_ = seq[1];
+               if (is_exactly_a<lst>(s_)) {
+                       const lst& s = ex_to<lst>(s_);
+                       for (lst::const_iterator it = s.begin(); it != s.end(); it++) {
+                               if ((*it).info(info_flags::positive)) {
+                                       continue;
+                               }
+                               return this->hold();
+                       }
+                       return zeta(m);
+               } else if (s_.info(info_flags::positive)) {
+                       return zeta(m);
+               }
+
+               return this->hold();
+       }
+}
+
+ex zeta_function::evalf(int level) const
+{
+       if (seq.size() == 1) {
+               // zeta1
+               const ex& x = seq[0];
+               if (is_exactly_a<lst>(x) && (x.nops()>1)) {
+
+                       // multiple zeta value
+                       const int count = x.nops();
+                       const lst& xlst = ex_to<lst>(x);
+                       std::vector<int> r(count);
+
+                       // check parameters and convert them
+                       lst::const_iterator it1 = xlst.begin();
+                       std::vector<int>::iterator it2 = r.begin();
+                       do {
+                               if (!(*it1).info(info_flags::posint)) {
+                                       return this->hold();
+                               }
+                               *it2 = ex_to<numeric>(*it1).to_int();
+                               it1++;
+                               it2++;
+                       } while (it2 != r.end());
+
+                       // check for divergence
+                       if (r[0] == 1) {
+                               return this->hold();
+                       }
+
+                       // decide on summation algorithm
+                       // this is still a bit clumsy
+                       int limit = (Digits>17) ? 10 : 6;
+                       if ((r[0] < limit) || ((count > 3) && (r[1] < limit/2))) {
+                               return numeric(zeta_do_sum_Crandall(r));
+                       } else {
+                               return numeric(zeta_do_sum_simple(r));
+                       }
+               }
+
+               // single zeta value
+               if (is_exactly_a<numeric>(x) && (x != 1)) {
+                       try {
+                               return zeta(ex_to<numeric>(x));
+                       } catch (const dunno &e) { }
+               }
+
+               return zeta(x).hold();
+       } else {
+               // zeta 2
+               const ex& x = seq[0];
+               const ex& s = seq[1];
+               if (is_exactly_a<lst>(x)) {
+
+                       // alternating Euler sum
+                       const int count = x.nops();
+                       const lst& xlst = ex_to<lst>(x);
+                       const lst& slst = ex_to<lst>(s);
+                       std::vector<int> xi(count);
+                       std::vector<int> si(count);
+
+                       // check parameters and convert them
+                       lst::const_iterator it_xread = xlst.begin();
+                       lst::const_iterator it_sread = slst.begin();
+                       std::vector<int>::iterator it_xwrite = xi.begin();
+                       std::vector<int>::iterator it_swrite = si.begin();
+                       do {
+                               if (!(*it_xread).info(info_flags::posint)) {
+                                       return this->hold();
+                               }
+                               *it_xwrite = ex_to<numeric>(*it_xread).to_int();
+                               if (*it_sread > 0) {
+                                       *it_swrite = 1;
+                               } else {
+                                       *it_swrite = -1;
+                               }
+                               it_xread++;
+                               it_sread++;
+                               it_xwrite++;
+                               it_swrite++;
+                       } while (it_xwrite != xi.end());
+
+                       // check for divergence
+                       if ((xi[0] == 1) && (si[0] == 1)) {
+                               return this->hold();
+                       }
+
+                       // use Hoelder convolution
+                       return numeric(zeta_do_Hoelder_convolution(xi, si));
+               }
+
+               return this->hold();
+       }
+}
+
+ex zeta_function::pderivative(unsigned deriv_param) const
+{
+       GINAC_ASSERT(deriv_param==0);
+
+       if (seq.size() == 1) {
+               // zeta 1
+               const ex& m = seq[0];
+               if (is_exactly_a<lst>(m)) {
+                       return _ex0;
+               } else {
+                       return zetaderiv(_ex1, m);
+               }
+       } else {
+               // zeta 2
+               const ex& m = seq[0];
+               const ex& s = seq[1];
+               if (is_exactly_a<lst>(m)) {
+                       return _ex0;
+               } else {
+                       if ((is_exactly_a<lst>(s) && s.op(0).info(info_flags::positive)) || s.info(info_flags::positive)) {
+                               return zetaderiv(_ex1, m);
+                       }
+                       return _ex0;
+               }
+       }
+}
+
+/** Numeric evaluation of Riemann's Zeta function.  Currently works only for
+ *  integer arguments. */
+numeric zeta_function::calc(const numeric& x)
+{
+       // A dirty hack to allow for things like zeta(3.0), since CLN currently
+       // only knows about integer arguments and zeta(3).evalf() automatically
+       // cascades down to zeta(3.0).evalf().  The trick is to rely on 3.0-3
+       // being an exact zero for CLN, which can be tested and then we can just
+       // pass the number casted to an int:
+       if (x.is_real()) {
+               const int aux = (int)(cln::double_approx(cln::the<cln::cl_R>(x.to_cl_N())));
+               if (cln::zerop(x.to_cl_N()-aux))
+                       return cln::zeta(aux);
+       }
+       throw dunno();
+}
+
+void zeta_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       if (seq.size() == 1) {
+               // zeta 1
+               const ex& m_ = seq[0];
+               c.s << "\\zeta(";
+               if (is_a<lst>(m_)) {
+                       const lst& m = ex_to<lst>(m_);
+                       lst::const_iterator it = m.begin();
+                       (*it).print(c);
+                       it++;
+                       for (; it != m.end(); it++) {
+                               c.s << ",";
+                               (*it).print(c);
+                       }
+               } else {
+                       m_.print(c);
+               }
+               c.s << ")";
+       } else {
+               // zeta 2
+               const ex& m_ = seq[0];
+               const ex& s_ = seq[1];
+               lst m;
+               if (is_a<lst>(m_)) {
+                       m = ex_to<lst>(m_);
+               } else {
+                       m = lst(m_);
+               }
+               lst s;
+               if (is_a<lst>(s_)) {
+                       s = ex_to<lst>(s_);
+               } else {
+                       s = lst(s_);
+               }
+               c.s << "\\zeta(";
+               lst::const_iterator itm = m.begin();
+               lst::const_iterator its = s.begin();
+               if (*its < 0) {
+                       c.s << "\\overline{";
+                       (*itm).print(c);
+                       c.s << "}";
+               } else {
+                       (*itm).print(c);
+               }
+               its++;
+               itm++;
+               for (; itm != m.end(); itm++, its++) {
+                       c.s << ",";
+                       if (*its < 0) {
+                               c.s << "\\overline{";
+                               (*itm).print(c);
+                               c.s << "}";
+                       } else {
+                               (*itm).print(c);
+                       }
+               }
+               c.s << ")";
+       }
+}
+
+//////////
+// Derivatives of Riemann's Zeta-function  zetaderiv(0,x)==zeta(x)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(zetaderiv_function,
+               print_func<print_latex>(&zetaderiv_function::do_print_latex))
+
+ex zetaderiv_function::eval(int level) const
+{
+       const ex& n = seq[0];
+       const ex& x = seq[1];
+       if (n.info(info_flags::numeric)) {
+               // zetaderiv(0,x) -> zeta(x)
+               if (n.is_zero())
+                       return zeta(x);
+       }
+       
+       return this->hold();
+}
+
+ex zetaderiv_function::pderivative(unsigned deriv_param) const
+{
+       GINAC_ASSERT(deriv_param<2);
+       
+       const ex& n = seq[0];
+       const ex& x = seq[1];
+       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);
+}
+
+void zetaderiv_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\zeta^\\prime";
+       inherited::do_print(c,level);
+}
+
+} // namespace GiNaC
diff --git a/ginac/inifcns_polylog.h b/ginac/inifcns_polylog.h
new file mode 100644 (file)
index 0000000..2569a7a
--- /dev/null
@@ -0,0 +1,148 @@
+/** @file inifcns_polylog.h
+ *
+ *  Interface to GiNaC's TODO */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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
+ */
+
+#ifndef __GINAC_INIFCNS_POLYLOG_H__
+#define __GINAC_INIFCNS_POLYLOG_H__
+
+#include "numeric.h"
+#include "function.h"
+#include "ex.h"
+#include "inifcns.h"
+
+namespace GiNaC {
+
+/** Generalized multiple polylogarithm. */
+class G_function : public function
+{
+       GINAC_DECLARE_FUNCTION(G_function)
+public:
+       /** Generalized multiple polylogarithm. */
+       G_function(const ex& x) : inherited(&G_function::tinfo_static, x) { }
+       /** Generalized multiple polylogarithm with explicit imaginary parts. */
+       G_function(const ex& x, const ex& y) : inherited(&G_function::tinfo_static, x, y) { }
+       /** Generalized multiple polylogarithm with explicit imaginary parts. */
+       G_function(const ex& x, const ex& s, const ex& y) : inherited(&G_function::tinfo_static, x, s, y) { }
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+};
+
+template<typename T1> inline G_function G(const T1& x1) { return G_function(x1); }
+template<typename T1, typename T2> inline G_function G(const T1& x1, const T2& x2) { return G_function(x1, x2); }
+template<typename T1, typename T2, typename T3> inline G_function G(const T1& x1, const T2& x2, const T3& x3) { return G_function(x1, x2, x3); }
+
+/** Polylogarithm and multiple polylogarithm. */
+class Li_function : public function
+{
+       GINAC_DECLARE_FUNCTION_2P(Li_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned deriv_param) const;
+       virtual ex series(const relational& r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1, typename T2> inline Li_function Li(const T1& x1, const T2& x2) { return Li_function(x1, x2); }
+
+/** Nielsen's generalized polylogarithm. */
+class S_function : public function
+{
+       GINAC_DECLARE_FUNCTION_3P(S_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned deriv_param) const;
+       virtual ex series(const relational& r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1, typename T2, typename T3> inline S_function S(const T1& x1, const T2& x2, const T3& x3) { return S_function(x1, x2, x3); }
+
+/** Harmonic polylogarithm. */
+class H_function : public function
+{
+       GINAC_DECLARE_FUNCTION_2P(H_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned deriv_param) const;
+       virtual ex series(const relational& r, int order, unsigned options = 0) const;
+       static bool do_eval;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1, typename T2> inline H_function H(const T1& x1, const T2& x2) { return H_function(x1, x2); }
+
+/** Multiple zeta value including Riemann's zeta-function. */
+class zeta_function : public function
+{
+       GINAC_DECLARE_FUNCTION(zeta_function)
+public:
+       /** Multiple zeta value including Riemann's zeta-function. */
+       zeta_function(const ex& x) : inherited(&zeta_function::tinfo_static, x) { }
+       /** Alternating Euler sum or colored MZV. */
+       zeta_function(const ex& x, const ex& s) : inherited(&zeta_function::tinfo_static, x, s) { }
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned deriv_param) const;
+public:
+       static numeric calc(const numeric& x);
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline zeta_function zeta(const T1& x1) { return zeta_function(x1); }
+//inline zeta_function zeta(const ex& x1) { return zeta_function(x1); }
+template<typename T1, typename T2> inline zeta_function zeta(const T1& x1, const T2& x2) { return zeta_function(x1, x2); }
+
+/** Converts a given list containing parameters for H in Remiddi/Vermaseren notation into
+ *  the corresponding GiNaC functions.
+ */
+ex convert_H_to_Li(const ex& parameterlst, const ex& arg);
+
+/** Dilogarithm. */
+template<typename T1> inline Li_function Li2(const T1& x1) { return Li_function(2, x1); }
+
+/** Trilogarithm. */
+template<typename T1> inline Li_function Li3(const T1& x1) { return Li_function(3, x1); }
+
+/** Derivatives of Riemann's Zeta-function. */
+class zetaderiv_function : public function
+{
+       GINAC_DECLARE_FUNCTION_2P(zetaderiv_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex pderivative(unsigned deriv_param) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1, typename T2> inline zetaderiv_function zetaderiv(const T1& x1, const T2& x2) { return zetaderiv_function(x1, x2); }
+
+} // namespace GiNaC
+
+#endif // ndef __GINAC_INIFCNS_H__
diff --git a/ginac/inifcns_trans.cpp b/ginac/inifcns_trans.cpp
deleted file mode 100644 (file)
index 70eccdc..0000000
+++ /dev/null
@@ -1,743 +0,0 @@
-/** @file inifcns_trans.cpp
- *
- *  Implementation of transcendental (and trigonometric and hyperbolic)
- *  functions. */
-
-/*
- *  GiNaC Copyright (C) 1999 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
- */
-
-#include <vector>
-#include <stdexcept>
-
-#include "inifcns.h"
-#include "ex.h"
-#include "constant.h"
-#include "numeric.h"
-#include "power.h"
-
-namespace GiNaC {
-
-//////////
-// exponential function
-//////////
-
-static ex exp_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-        TYPECHECK(x,numeric)
-    END_TYPECHECK(exp(x))
-    
-    return exp(ex_to_numeric(x)); // -> numeric exp(numeric)
-}
-
-static ex exp_eval(ex const & x)
-{
-    // exp(0) -> 1
-    if (x.is_zero()) {
-        return exONE();
-    }
-    // exp(n*Pi*I/2) -> {+1|+I|-1|-I}
-    ex TwoExOverPiI=(2*x)/(Pi*I);
-    if (TwoExOverPiI.info(info_flags::integer)) {
-        numeric z=mod(ex_to_numeric(TwoExOverPiI),numeric(4));
-        if (z.is_equal(numZERO()))
-            return exONE();
-        if (z.is_equal(numONE()))
-            return ex(I);
-        if (z.is_equal(numTWO()))
-            return exMINUSONE();
-        if (z.is_equal(numTHREE()))
-            return ex(-I);
-    }
-    // exp(log(x)) -> x
-    if (is_ex_the_function(x, log))
-        return x.op(0);
-    
-    // exp(float)
-    if (x.info(info_flags::numeric) && !x.info(info_flags::rational))
-        return exp_evalf(x);
-    
-    return exp(x).hold();
-}    
-
-static ex exp_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-
-    return exp(x);
-}
-
-REGISTER_FUNCTION(exp, exp_eval, exp_evalf, exp_diff, NULL);
-
-//////////
-// natural logarithm
-//////////
-
-static ex log_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-        TYPECHECK(x,numeric)
-    END_TYPECHECK(log(x))
-    
-    return log(ex_to_numeric(x)); // -> numeric log(numeric)
-}
-
-static ex log_eval(ex const & x)
-{
-    if (x.info(info_flags::numeric)) {
-        // log(1) -> 0
-        if (x.is_equal(exONE()))
-            return exZERO();
-        // log(-1) -> I*Pi
-        if (x.is_equal(exMINUSONE()))
-            return (I*Pi);
-        // log(I) -> Pi*I/2
-        if (x.is_equal(I))
-            return (I*Pi*numeric(1,2));
-        // log(-I) -> -Pi*I/2
-        if (x.is_equal(-I))
-            return (I*Pi*numeric(-1,2));
-        // log(0) -> throw singularity
-        if (x.is_equal(exZERO()))
-            throw(std::domain_error("log_eval(): log(0)"));
-        // log(float)
-        if (!x.info(info_flags::rational))
-            return log_evalf(x);
-    }
-    
-    return log(x).hold();
-}    
-
-static ex log_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-
-    return power(x, -1);
-}
-
-REGISTER_FUNCTION(log, log_eval, log_evalf, log_diff, NULL);
-
-//////////
-// sine (trigonometric function)
-//////////
-
-static ex sin_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-       TYPECHECK(x,numeric)
-    END_TYPECHECK(sin(x))
-    
-    return sin(ex_to_numeric(x)); // -> numeric sin(numeric)
-}
-
-static ex sin_eval(ex const & x)
-{
-    // sin(n*Pi) -> 0
-    ex xOverPi=x/Pi;
-    if (xOverPi.info(info_flags::integer))
-        return exZERO();
-    
-    // sin((2n+1)*Pi/2) -> {+|-}1
-    ex xOverPiMinusHalf=xOverPi-exHALF();
-    if (xOverPiMinusHalf.info(info_flags::even))
-        return exONE();
-    else if (xOverPiMinusHalf.info(info_flags::odd))
-        return exMINUSONE();
-    
-    if (is_ex_exactly_of_type(x, function)) {
-        ex t=x.op(0);
-        // sin(asin(x)) -> x
-        if (is_ex_the_function(x, asin))
-            return t;
-        // sin(acos(x)) -> (1-x^2)^(1/2)
-        if (is_ex_the_function(x, acos))
-            return power(exONE()-power(t,exTWO()),exHALF());
-        // sin(atan(x)) -> x*(1+x^2)^(-1/2)
-        if (is_ex_the_function(x, atan))
-            return t*power(exONE()+power(t,exTWO()),exMINUSHALF());
-    }
-    
-    // sin(float) -> float
-    if (x.info(info_flags::numeric) && !x.info(info_flags::rational))
-        return sin_evalf(x);
-    
-    return sin(x).hold();
-}
-
-static ex sin_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-    
-    return cos(x);
-}
-
-REGISTER_FUNCTION(sin, sin_eval, sin_evalf, sin_diff, NULL);
-
-//////////
-// cosine (trigonometric function)
-//////////
-
-static ex cos_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-        TYPECHECK(x,numeric)
-    END_TYPECHECK(cos(x))
-    
-    return cos(ex_to_numeric(x)); // -> numeric cos(numeric)
-}
-
-static ex cos_eval(ex const & x)
-{
-    // cos(n*Pi) -> {+|-}1
-    ex xOverPi=x/Pi;
-    if (xOverPi.info(info_flags::even))
-        return exONE();
-    else if (xOverPi.info(info_flags::odd))
-        return exMINUSONE();
-    
-    // cos((2n+1)*Pi/2) -> 0
-    ex xOverPiMinusHalf=xOverPi-exHALF();
-    if (xOverPiMinusHalf.info(info_flags::integer))
-        return exZERO();
-    
-    if (is_ex_exactly_of_type(x, function)) {
-        ex t=x.op(0);
-        // cos(acos(x)) -> x
-        if (is_ex_the_function(x, acos))
-            return t;
-        // cos(asin(x)) -> (1-x^2)^(1/2)
-        if (is_ex_the_function(x, asin))
-            return power(exONE()-power(t,exTWO()),exHALF());
-        // cos(atan(x)) -> (1+x^2)^(-1/2)
-        if (is_ex_the_function(x, atan))
-            return power(exONE()+power(t,exTWO()),exMINUSHALF());
-    }
-    
-    // cos(float) -> float
-    if (x.info(info_flags::numeric) && !x.info(info_flags::rational))
-        return cos_evalf(x);
-    
-    return cos(x).hold();
-}
-
-static ex cos_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-
-    return numMINUSONE()*sin(x);
-}
-
-REGISTER_FUNCTION(cos, cos_eval, cos_evalf, cos_diff, NULL);
-
-//////////
-// tangent (trigonometric function)
-//////////
-
-static ex tan_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-       TYPECHECK(x,numeric)
-    END_TYPECHECK(tan(x)) // -> numeric tan(numeric)
-    
-    return tan(ex_to_numeric(x));
-}
-
-static ex tan_eval(ex const & x)
-{
-    // tan(n*Pi/3) -> {0|3^(1/2)|-(3^(1/2))}
-    ex ThreeExOverPi=numTHREE()*x/Pi;
-    if (ThreeExOverPi.info(info_flags::integer)) {
-        numeric z=mod(ex_to_numeric(ThreeExOverPi),numeric(3));
-        if (z.is_equal(numZERO()))
-            return exZERO();
-        if (z.is_equal(numONE()))
-            return power(exTHREE(),exHALF());
-        if (z.is_equal(numTWO()))
-            return -power(exTHREE(),exHALF());
-    }
-    
-    // tan((2n+1)*Pi/2) -> throw
-    ex ExOverPiMinusHalf=x/Pi-exHALF();
-    if (ExOverPiMinusHalf.info(info_flags::integer))
-        throw (std::domain_error("tan_eval(): infinity"));
-    
-    if (is_ex_exactly_of_type(x, function)) {
-        ex t=x.op(0);
-        // tan(atan(x)) -> x
-        if (is_ex_the_function(x, atan))
-            return t;
-        // tan(asin(x)) -> x*(1+x^2)^(-1/2)
-        if (is_ex_the_function(x, asin))
-            return t*power(exONE()-power(t,exTWO()),exMINUSHALF());
-        // tan(acos(x)) -> (1-x^2)^(1/2)/x
-        if (is_ex_the_function(x, acos))
-            return power(t,exMINUSONE())*power(exONE()-power(t,exTWO()),exHALF());
-    }
-    
-    // tan(float) -> float
-    if (x.info(info_flags::numeric) && !x.info(info_flags::rational)) {
-        return tan_evalf(x);
-    }
-    
-    return tan(x).hold();
-}
-
-static ex tan_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-    
-    return (1+power(tan(x),exTWO()));
-}
-
-REGISTER_FUNCTION(tan, tan_eval, tan_evalf, tan_diff, NULL);
-
-//////////
-// inverse sine (arc sine)
-//////////
-
-static ex asin_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-       TYPECHECK(x,numeric)
-    END_TYPECHECK(asin(x))
-    
-    return asin(ex_to_numeric(x)); // -> numeric asin(numeric)
-}
-
-static ex asin_eval(ex const & x)
-{
-    if (x.info(info_flags::numeric)) {
-        // asin(0) -> 0
-        if (x.is_zero())
-            return x;
-        // asin(1/2) -> Pi/6
-        if (x.is_equal(exHALF()))
-            return numeric(1,6)*Pi;
-        // asin(1) -> Pi/2
-        if (x.is_equal(exONE()))
-            return numeric(1,2)*Pi;
-        // asin(-1/2) -> -Pi/6
-        if (x.is_equal(exMINUSHALF()))
-            return numeric(-1,6)*Pi;
-        // asin(-1) -> -Pi/2
-        if (x.is_equal(exMINUSONE()))
-            return numeric(-1,2)*Pi;
-        // asin(float) -> float
-        if (!x.info(info_flags::rational))
-            return asin_evalf(x);
-    }
-    
-    return asin(x).hold();
-}
-
-static ex asin_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-    
-    return power(1-power(x,exTWO()),exMINUSHALF());
-}
-
-REGISTER_FUNCTION(asin, asin_eval, asin_evalf, asin_diff, NULL);
-
-//////////
-// inverse cosine (arc cosine)
-//////////
-
-static ex acos_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-       TYPECHECK(x,numeric)
-    END_TYPECHECK(acos(x))
-    
-    return acos(ex_to_numeric(x)); // -> numeric acos(numeric)
-}
-
-static ex acos_eval(ex const & x)
-{
-    if (x.info(info_flags::numeric)) {
-        // acos(1) -> 0
-        if (x.is_equal(exONE()))
-            return exZERO();
-        // acos(1/2) -> Pi/3
-        if (x.is_equal(exHALF()))
-            return numeric(1,3)*Pi;
-        // acos(0) -> Pi/2
-        if (x.is_zero())
-            return numeric(1,2)*Pi;
-        // acos(-1/2) -> 2/3*Pi
-        if (x.is_equal(exMINUSHALF()))
-            return numeric(2,3)*Pi;
-        // acos(-1) -> Pi
-        if (x.is_equal(exMINUSONE()))
-            return Pi;
-        // acos(float) -> float
-        if (!x.info(info_flags::rational))
-            return acos_evalf(x);
-    }
-    
-    return acos(x).hold();
-}
-
-static ex acos_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-    
-    return numMINUSONE()*power(1-power(x,exTWO()),exMINUSHALF());
-}
-
-REGISTER_FUNCTION(acos, acos_eval, acos_evalf, acos_diff, NULL);
-
-//////////
-// inverse tangent (arc tangent)
-//////////
-
-static ex atan_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-        TYPECHECK(x,numeric)
-    END_TYPECHECK(atan(x))
-    
-    return atan(ex_to_numeric(x)); // -> numeric atan(numeric)
-}
-
-static ex atan_eval(ex const & x)
-{
-    if (x.info(info_flags::numeric)) {
-        // atan(0) -> 0
-        if (x.is_equal(exZERO()))
-            return exZERO();
-        // atan(float) -> float
-        if (!x.info(info_flags::rational))
-            return atan_evalf(x);
-    }
-    
-    return atan(x).hold();
-}    
-
-static ex atan_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-
-    return power(1+x*x, -1);
-}
-
-REGISTER_FUNCTION(atan, atan_eval, atan_evalf, atan_diff, NULL);
-
-//////////
-// inverse tangent (atan2(y,x))
-//////////
-
-static ex atan2_evalf(ex const & y, ex const & x)
-{
-    BEGIN_TYPECHECK
-        TYPECHECK(y,numeric)
-        TYPECHECK(x,numeric)
-    END_TYPECHECK(atan2(y,x))
-    
-    return atan(ex_to_numeric(y),ex_to_numeric(x)); // -> numeric atan(numeric)
-}
-
-static ex atan2_eval(ex const & y, ex const & x)
-{
-    if (y.info(info_flags::numeric) && !y.info(info_flags::rational) &&
-        x.info(info_flags::numeric) && !x.info(info_flags::rational)) {
-        return atan2_evalf(y,x);
-    }
-    
-    return atan2(y,x).hold();
-}    
-
-static ex atan2_diff(ex const & y, ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param<2);
-    
-    if (diff_param==0) {
-        // d/dy atan(y,x)
-        return pow(x*(1+y*y/(x*x)),-1);
-    }
-    // d/dx atan(y,x)
-    return -y*pow(x*x+y*y,-1);
-}
-
-REGISTER_FUNCTION(atan2, atan2_eval, atan2_evalf, atan2_diff, NULL);
-
-//////////
-// hyperbolic sine (trigonometric function)
-//////////
-
-static ex sinh_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-       TYPECHECK(x,numeric)
-    END_TYPECHECK(sinh(x))
-    
-    return sinh(ex_to_numeric(x)); // -> numeric sinh(numeric)
-}
-
-static ex sinh_eval(ex const & x)
-{
-    if (x.info(info_flags::numeric)) {
-        // sinh(0) -> 0
-        if (x.is_zero())
-            return exZERO();
-        // sinh(float) -> float
-        if (!x.info(info_flags::rational))
-            return sinh_evalf(x);
-    }
-    
-    if (is_ex_exactly_of_type(x, function)) {
-        ex t=x.op(0);
-        // sinh(asinh(x)) -> x
-        if (is_ex_the_function(x, asinh))
-            return t;
-        // sinh(acosh(x)) -> (x-1)^(1/2) * (x+1)^(1/2)
-        if (is_ex_the_function(x, acosh))
-            return power(t-exONE(),exHALF())*power(t+exONE(),exHALF());
-        // sinh(atanh(x)) -> x*(1-x^2)^(-1/2)
-        if (is_ex_the_function(x, atanh))
-            return t*power(exONE()-power(t,exTWO()),exMINUSHALF());
-    }
-    
-    return sinh(x).hold();
-}
-
-static ex sinh_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-    
-    return cosh(x);
-}
-
-REGISTER_FUNCTION(sinh, sinh_eval, sinh_evalf, sinh_diff, NULL);
-
-//////////
-// hyperbolic cosine (trigonometric function)
-//////////
-
-static ex cosh_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-       TYPECHECK(x,numeric)
-    END_TYPECHECK(cosh(x))
-    
-    return cosh(ex_to_numeric(x)); // -> numeric cosh(numeric)
-}
-
-static ex cosh_eval(ex const & x)
-{
-    if (x.info(info_flags::numeric)) {
-        // cosh(0) -> 1
-        if (x.is_zero())
-            return exONE();
-        // cosh(float) -> float
-        if (!x.info(info_flags::rational))
-            return cosh_evalf(x);
-    }
-    
-    if (is_ex_exactly_of_type(x, function)) {
-        ex t=x.op(0);
-        // cosh(acosh(x)) -> x
-        if (is_ex_the_function(x, acosh))
-            return t;
-        // cosh(asinh(x)) -> (1+x^2)^(1/2)
-        if (is_ex_the_function(x, asinh))
-            return power(exONE()+power(t,exTWO()),exHALF());
-        // cosh(atanh(x)) -> (1-x^2)^(-1/2)
-        if (is_ex_the_function(x, atanh))
-            return power(exONE()-power(t,exTWO()),exMINUSHALF());
-    }
-    
-    return cosh(x).hold();
-}
-
-static ex cosh_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-    
-    return sinh(x);
-}
-
-REGISTER_FUNCTION(cosh, cosh_eval, cosh_evalf, cosh_diff, NULL);
-
-//////////
-// hyperbolic tangent (trigonometric function)
-//////////
-
-static ex tanh_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-       TYPECHECK(x,numeric)
-    END_TYPECHECK(tanh(x))
-    
-    return tanh(ex_to_numeric(x)); // -> numeric tanh(numeric)
-}
-
-static ex tanh_eval(ex const & x)
-{
-    if (x.info(info_flags::numeric)) {
-        // tanh(0) -> 0
-        if (x.is_zero())
-            return exZERO();
-        // tanh(float) -> float
-        if (!x.info(info_flags::rational))
-            return tanh_evalf(x);
-    }
-    
-    if (is_ex_exactly_of_type(x, function)) {
-        ex t=x.op(0);
-        // tanh(atanh(x)) -> x
-        if (is_ex_the_function(x, atanh))
-            return t;
-        // tanh(asinh(x)) -> x*(1+x^2)^(-1/2)
-        if (is_ex_the_function(x, asinh))
-            return t*power(exONE()+power(t,exTWO()),exMINUSHALF());
-        // tanh(acosh(x)) -> (x-1)^(1/2)*(x+1)^(1/2)/x
-        if (is_ex_the_function(x, acosh))
-            return power(t-exONE(),exHALF())*power(t+exONE(),exHALF())*power(t,exMINUSONE());
-    }
-    
-    return tanh(x).hold();
-}
-
-static ex tanh_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-    
-    return exONE()-power(tanh(x),exTWO());
-}
-
-REGISTER_FUNCTION(tanh, tanh_eval, tanh_evalf, tanh_diff, NULL);
-
-//////////
-// inverse hyperbolic sine (trigonometric function)
-//////////
-
-static ex asinh_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-       TYPECHECK(x,numeric)
-    END_TYPECHECK(asinh(x))
-    
-    return asinh(ex_to_numeric(x)); // -> numeric asinh(numeric)
-}
-
-static ex asinh_eval(ex const & x)
-{
-    if (x.info(info_flags::numeric)) {
-        // asinh(0) -> 0
-        if (x.is_zero())
-            return exZERO();
-        // asinh(float) -> float
-        if (!x.info(info_flags::rational))
-            return asinh_evalf(x);
-    }
-    
-    return asinh(x).hold();
-}
-
-static ex asinh_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-    
-    return power(1+power(x,exTWO()),exMINUSHALF());
-}
-
-REGISTER_FUNCTION(asinh, asinh_eval, asinh_evalf, asinh_diff, NULL);
-
-//////////
-// inverse hyperbolic cosine (trigonometric function)
-//////////
-
-static ex acosh_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-       TYPECHECK(x,numeric)
-    END_TYPECHECK(acosh(x))
-    
-    return acosh(ex_to_numeric(x)); // -> numeric acosh(numeric)
-}
-
-static ex acosh_eval(ex const & x)
-{
-    if (x.info(info_flags::numeric)) {
-        // acosh(0) -> Pi*I/2
-        if (x.is_zero())
-            return Pi*I*numeric(1,2);
-        // acosh(1) -> 0
-        if (x.is_equal(exONE()))
-            return exZERO();
-        // acosh(-1) -> Pi*I
-        if (x.is_equal(exMINUSONE()))
-            return Pi*I;
-        // acosh(float) -> float
-        if (!x.info(info_flags::rational))
-            return acosh_evalf(x);
-    }
-    
-    return acosh(x).hold();
-}
-
-static ex acosh_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-    
-    return power(x-1,exMINUSHALF())*power(x+1,exMINUSHALF());
-}
-
-REGISTER_FUNCTION(acosh, acosh_eval, acosh_evalf, acosh_diff, NULL);
-
-//////////
-// inverse hyperbolic tangent (trigonometric function)
-//////////
-
-static ex atanh_evalf(ex const & x)
-{
-    BEGIN_TYPECHECK
-       TYPECHECK(x,numeric)
-    END_TYPECHECK(atanh(x))
-    
-    return atanh(ex_to_numeric(x)); // -> numeric atanh(numeric)
-}
-
-static ex atanh_eval(ex const & x)
-{
-    if (x.info(info_flags::numeric)) {
-        // atanh(0) -> 0
-        if (x.is_zero())
-            return exZERO();
-        // atanh({+|-}1) -> throw
-        if (x.is_equal(exONE()) || x.is_equal(exONE()))
-            throw (std::domain_error("atanh_eval(): infinity"));
-        // atanh(float) -> float
-        if (!x.info(info_flags::rational))
-            return atanh_evalf(x);
-    }
-    
-    return atanh(x).hold();
-}
-
-static ex atanh_diff(ex const & x, unsigned diff_param)
-{
-    GINAC_ASSERT(diff_param==0);
-    
-    return power(exONE()-power(x,exTWO()),exMINUSONE());
-}
-
-REGISTER_FUNCTION(atanh, atanh_eval, atanh_evalf, atanh_diff, NULL);
-
-} // namespace GiNaC
diff --git a/ginac/inifcns_trig.cpp b/ginac/inifcns_trig.cpp
new file mode 100644 (file)
index 0000000..82dbf7e
--- /dev/null
@@ -0,0 +1,1116 @@
+/** @file inifcns_trig.cpp
+ *
+ *  Implementation of trigonometric functions. */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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 "inifcns_trig.h"
+
+#include "inifcns.h"
+#include "inifcns_exp.h"
+#include "ex.h"
+#include "constant.h"
+#include "numeric.h"
+#include "power.h"
+#include "operators.h"
+#include "relational.h"
+#include "symbol.h"
+#include "pseries.h"
+#include "utils.h"
+
+#include <stdexcept>
+#include <string>
+
+namespace GiNaC {
+
+////////////////////////////////////////////////////////////////////////////////
+// sine (trigonometric function)
+////////////////////////////////////////////////////////////////////////////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(sin_function,
+               print_func<print_latex>(&sin_function::do_print_latex))
+
+ex sin_function::eval(int level) const
+{
+       const ex& x = seq[0];
+       // sin(n/d*Pi) -> { all known non-nested radicals }
+       const ex SixtyExOverPi = _ex60*x/Pi;
+       ex sign = _ex1;
+       if (SixtyExOverPi.info(info_flags::integer)) {
+               numeric z = mod(ex_to<numeric>(SixtyExOverPi),*_num120_p);
+               if (z>=*_num60_p) {
+                       // wrap to interval [0, Pi)
+                       z -= *_num60_p;
+                       sign = _ex_1;
+               }
+               if (z>*_num30_p) {
+                       // wrap to interval [0, Pi/2)
+                       z = *_num60_p-z;
+               }
+               if (z.is_equal(*_num0_p))  // sin(0)       -> 0
+                       return _ex0;
+               if (z.is_equal(*_num5_p))  // sin(Pi/12)   -> sqrt(6)/4*(1-sqrt(3)/3)
+                       return sign*_ex1_4*sqrt(_ex6)*(_ex1+_ex_1_3*sqrt(_ex3));
+               if (z.is_equal(*_num6_p))  // sin(Pi/10)   -> sqrt(5)/4-1/4
+                       return sign*(_ex1_4*sqrt(_ex5)+_ex_1_4);
+               if (z.is_equal(*_num10_p)) // sin(Pi/6)    -> 1/2
+                       return sign*_ex1_2;
+               if (z.is_equal(*_num15_p)) // sin(Pi/4)    -> sqrt(2)/2
+                       return sign*_ex1_2*sqrt(_ex2);
+               if (z.is_equal(*_num18_p)) // sin(3/10*Pi) -> sqrt(5)/4+1/4
+                       return sign*(_ex1_4*sqrt(_ex5)+_ex1_4);
+               if (z.is_equal(*_num20_p)) // sin(Pi/3)    -> sqrt(3)/2
+                       return sign*_ex1_2*sqrt(_ex3);
+               if (z.is_equal(*_num25_p)) // sin(5/12*Pi) -> sqrt(6)/4*(1+sqrt(3)/3)
+                       return sign*_ex1_4*sqrt(_ex6)*(_ex1+_ex1_3*sqrt(_ex3));
+               if (z.is_equal(*_num30_p)) // sin(Pi/2)    -> 1
+                       return sign;
+       }
+
+       if (is_exactly_a<asin_function>(x)) {
+               // sin(asin(x)) -> x
+               return x.op(0);
+       } else if (is_exactly_a<acos_function>(x)) {
+               // sin(acos(x)) -> sqrt(1-x^2)
+               return sqrt(_ex1-power::power(x.op(0),_ex2));
+       } else if (is_exactly_a<atan_function>(x)) {
+               const ex& t = x.op(0);
+               // sin(atan(x)) -> x/sqrt(1+x^2)
+               return t*power::power(_ex1+power::power(t,_ex2),_ex_1_2);
+       }
+       
+       // sin(float) -> float
+       if (x.info(info_flags::numeric) && !x.info(info_flags::crational))
+               return sin(ex_to<numeric>(x));
+
+       // sin() is odd
+       if (x.info(info_flags::negative))
+               return -sin(-x);
+       
+       return this->hold();
+}
+
+ex sin_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x))
+               return sin(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex sin_function::pderivative(unsigned deriv_param) const
+{
+    GINAC_ASSERT(deriv_param==0);
+       // d/dx sin(x) -> cos(x)
+       return cos(seq[0]);
+}
+
+void sin_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\sin";
+       inherited::do_print(c,level);
+}
+
+//////////
+// cosine (trigonometric function)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(cos_function,
+               print_func<print_latex>(&cos_function::do_print_latex))
+
+ex cos_function::eval(int level) const
+{
+       const ex& x = seq[0];
+       // cos(n/d*Pi) -> { all known non-nested radicals }
+       const ex SixtyExOverPi = _ex60*x/Pi;
+       ex sign = _ex1;
+       if (SixtyExOverPi.info(info_flags::integer)) {
+               numeric z = mod(ex_to<numeric>(SixtyExOverPi),*_num120_p);
+               if (z>=*_num60_p) {
+                       // wrap to interval [0, Pi)
+                       z = *_num120_p-z;
+               }
+               if (z>=*_num30_p) {
+                       // wrap to interval [0, Pi/2)
+                       z = *_num60_p-z;
+                       sign = _ex_1;
+               }
+               if (z.is_equal(*_num0_p))  // cos(0)       -> 1
+                       return sign;
+               if (z.is_equal(*_num5_p))  // cos(Pi/12)   -> sqrt(6)/4*(1+sqrt(3)/3)
+                       return sign*_ex1_4*sqrt(_ex6)*(_ex1+_ex1_3*sqrt(_ex3));
+               if (z.is_equal(*_num10_p)) // cos(Pi/6)    -> sqrt(3)/2
+                       return sign*_ex1_2*sqrt(_ex3);
+               if (z.is_equal(*_num12_p)) // cos(Pi/5)    -> sqrt(5)/4+1/4
+                       return sign*(_ex1_4*sqrt(_ex5)+_ex1_4);
+               if (z.is_equal(*_num15_p)) // cos(Pi/4)    -> sqrt(2)/2
+                       return sign*_ex1_2*sqrt(_ex2);
+               if (z.is_equal(*_num20_p)) // cos(Pi/3)    -> 1/2
+                       return sign*_ex1_2;
+               if (z.is_equal(*_num24_p)) // cos(2/5*Pi)  -> sqrt(5)/4-1/4x
+                       return sign*(_ex1_4*sqrt(_ex5)+_ex_1_4);
+               if (z.is_equal(*_num25_p)) // cos(5/12*Pi) -> sqrt(6)/4*(1-sqrt(3)/3)
+                       return sign*_ex1_4*sqrt(_ex6)*(_ex1+_ex_1_3*sqrt(_ex3));
+               if (z.is_equal(*_num30_p)) // cos(Pi/2)    -> 0
+                       return _ex0;
+       }
+
+       if (is_exactly_a<acos_function>(x)) {
+               // cos(acos(x)) -> x
+               return x.op(0);
+       } else if (is_exactly_a<asin_function>(x)) {
+               // cos(asin(x)) -> sqrt(1-x^2)
+               return sqrt(_ex1-power::power(x.op(0),_ex2));
+       } else if (is_exactly_a<atan_function>(x)) {
+               // cos(atan(x)) -> 1/sqrt(1+x^2)
+               return power::power(_ex1+power::power(x.op(0),_ex2),_ex_1_2);
+       }
+       
+       // cos(float) -> float
+       if (x.info(info_flags::numeric) && !x.info(info_flags::crational))
+               return cos(ex_to<numeric>(x));
+       
+       // cos() is even
+       if (x.info(info_flags::negative))
+               return cos(-x);
+       
+       return this->hold();
+}
+
+ex cos_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x))
+               return cos(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex cos_function::pderivative(unsigned deriv_param) const
+{
+       GINAC_ASSERT(deriv_param==0);
+
+       // d/dx cos(x) -> -sin(x)
+       return -sin(seq[0]);
+}
+
+void cos_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\cos";
+       inherited::do_print(c,level);
+}
+
+//////////
+// tangent (trigonometric function)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(tan_function,
+               print_func<print_latex>(&tan_function::do_print_latex))
+
+ex tan_function::eval(int level) const
+{
+       const ex& x = seq[0];
+       // tan(n/d*Pi) -> { all known non-nested radicals }
+       const ex SixtyExOverPi = _ex60*x/Pi;
+       ex sign = _ex1;
+       if (SixtyExOverPi.info(info_flags::integer)) {
+               numeric z = mod(ex_to<numeric>(SixtyExOverPi),*_num60_p);
+               if (z>=*_num60_p) {
+                       // wrap to interval [0, Pi)
+                       z -= *_num60_p;
+               }
+               if (z>=*_num30_p) {
+                       // wrap to interval [0, Pi/2)
+                       z = *_num60_p-z;
+                       sign = _ex_1;
+               }
+               if (z.is_equal(*_num0_p))  // tan(0)       -> 0
+                       return _ex0;
+               if (z.is_equal(*_num5_p))  // tan(Pi/12)   -> 2-sqrt(3)
+                       return sign*(_ex2-sqrt(_ex3));
+               if (z.is_equal(*_num10_p)) // tan(Pi/6)    -> sqrt(3)/3
+                       return sign*_ex1_3*sqrt(_ex3);
+               if (z.is_equal(*_num15_p)) // tan(Pi/4)    -> 1
+                       return sign;
+               if (z.is_equal(*_num20_p)) // tan(Pi/3)    -> sqrt(3)
+                       return sign*sqrt(_ex3);
+               if (z.is_equal(*_num25_p)) // tan(5/12*Pi) -> 2+sqrt(3)
+                       return sign*(sqrt(_ex3)+_ex2);
+               if (z.is_equal(*_num30_p)) // tan(Pi/2)    -> infinity
+                       throw (pole_error("tan_eval(): simple pole",1));
+       }
+
+       if (is_exactly_a<atan_function>(x)) {
+               // tan(atan(x)) -> x
+               return x.op(0);
+       } else if (is_exactly_a<asin_function>(x)) {
+               // tan(asin(x)) -> x/sqrt(1+x^2)
+               const ex& t = x.op(0);
+               return t*power::power(_ex1-power::power(t,_ex2),_ex_1_2);
+       } else if (is_exactly_a<acos_function>(x)) {
+               // tan(acos(x)) -> sqrt(1-x^2)/x
+               const ex& t = x.op(0);
+               return power::power(t,_ex_1)*sqrt(_ex1-power::power(t,_ex2));
+       }
+       
+       // tan(float) -> float
+       if (x.info(info_flags::numeric) && !x.info(info_flags::crational)) {
+               return tan(ex_to<numeric>(x));
+       }
+       
+       // tan() is odd
+       if (x.info(info_flags::negative)) {
+               return -tan(-x);
+       }
+       
+       return this->hold();
+}
+
+ex tan_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x))
+               return tan(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex tan_function::pderivative(unsigned deriv_param) const
+{
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx tan(x) -> 1+tan(x)^2;
+       return (_ex1+power::power(tan(seq[0]),_ex2));
+}
+
+ex tan_function::series(const relational& rel, int order, unsigned options) const
+{
+       GINAC_ASSERT(is_a<symbol>(rel.lhs()));
+       // method:
+       // Taylor series where there is no pole falls back to tan_deriv.
+       // On a pole simply expand sin(x)/cos(x).
+       const ex x_pt = seq[0].subs(rel, subs_options::no_pattern);
+       if (!(2*x_pt/Pi).info(info_flags::odd)) {
+               return basic::series(rel, order, options);
+       }
+       // if we got here we have to care for a simple pole
+       const ex& x = seq[0];
+       return (sin(x)/cos(x)).series(rel, order, options);
+}
+
+void tan_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\tan";
+       inherited::do_print(c,level);
+}
+
+//////////
+// inverse sine (arc sine)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(asin_function,
+               print_func<print_latex>(&asin_function::do_print_latex))
+
+ex asin_function::eval(int level) const
+{
+       const ex& x = seq[0];
+
+       if (x.info(info_flags::numeric)) {
+
+               // asin(0) -> 0
+               if (x.is_zero())
+                       return x;
+
+               // asin(1/2) -> Pi/6
+               if (x.is_equal(_ex1_2))
+                       return numeric(1,6)*Pi;
+
+               // asin(1) -> Pi/2
+               if (x.is_equal(_ex1))
+                       return _ex1_2*Pi;
+
+               // asin(-1/2) -> -Pi/6
+               if (x.is_equal(_ex_1_2))
+                       return numeric(-1,6)*Pi;
+
+               // asin(-1) -> -Pi/2
+               if (x.is_equal(_ex_1))
+                       return _ex_1_2*Pi;
+
+               // asin(float) -> float
+               if (!x.info(info_flags::crational))
+                       return asin(ex_to<numeric>(x));
+
+               // asin() is odd
+               if (x.info(info_flags::negative))
+                       return -asin(-x);
+       }
+       
+       return this->hold();
+}
+
+ex asin_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x))
+               return asin(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex asin_function::pderivative(unsigned deriv_param) const
+{
+       const ex& x = seq[0];
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx asin(x) -> 1/sqrt(1-x^2)
+       return power::power(1-power::power(x,_ex2),_ex_1_2);
+}
+
+void asin_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\arcsin";
+       inherited::do_print(c,level);
+}
+
+//////////
+// inverse cosine (arc cosine)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(acos_function,
+               print_func<print_latex>(&acos_function::do_print_latex))
+
+ex acos_function::eval(int level) const
+{
+       const ex& x = seq[0];
+
+       if (x.info(info_flags::numeric)) {
+
+               // acos(1) -> 0
+               if (x.is_equal(_ex1))
+                       return _ex0;
+
+               // acos(1/2) -> Pi/3
+               if (x.is_equal(_ex1_2))
+                       return _ex1_3*Pi;
+
+               // acos(0) -> Pi/2
+               if (x.is_zero())
+                       return _ex1_2*Pi;
+
+               // acos(-1/2) -> 2/3*Pi
+               if (x.is_equal(_ex_1_2))
+                       return numeric(2,3)*Pi;
+
+               // acos(-1) -> Pi
+               if (x.is_equal(_ex_1))
+                       return Pi;
+
+               // acos(float) -> float
+               if (!x.info(info_flags::crational))
+                       return acos(ex_to<numeric>(x));
+
+               // acos(-x) -> Pi-acos(x)
+               if (x.info(info_flags::negative))
+                       return Pi-acos(-x);
+       }
+       
+       return this->hold();
+}
+
+ex acos_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x))
+               return acos(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex acos_function::pderivative(unsigned deriv_param) const
+{
+       const ex& x = seq[0];
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx acos(x) -> -1/sqrt(1-x^2)
+       return -power::power(1-power::power(x,_ex2),_ex_1_2);
+}
+
+void acos_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\arccos";
+       inherited::do_print(c,level);
+}
+
+//////////
+// inverse tangent (arc tangent)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(atan_function,
+               print_func<print_latex>(&atan_function::do_print_latex))
+
+ex atan_function::eval(int level) const
+{
+       const ex& x = seq[0];
+
+       if (x.info(info_flags::numeric)) {
+
+               // atan(0) -> 0
+               if (x.is_zero())
+                       return _ex0;
+
+               // atan(1) -> Pi/4
+               if (x.is_equal(_ex1))
+                       return _ex1_4*Pi;
+
+               // atan(-1) -> -Pi/4
+               if (x.is_equal(_ex_1))
+                       return _ex_1_4*Pi;
+
+               if (x.is_equal(I) || x.is_equal(-I))
+                       throw (pole_error("atan_eval(): logarithmic pole",0));
+
+               // atan(float) -> float
+               if (!x.info(info_flags::crational))
+                       return atan(ex_to<numeric>(x));
+
+               // atan() is odd
+               if (x.info(info_flags::negative))
+                       return -atan(-x);
+       }
+       
+       return this->hold();
+}
+
+ex atan_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x))
+               return atan(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex atan_function::pderivative(unsigned deriv_param) const
+{
+       const ex& x = seq[0];
+       GINAC_ASSERT(deriv_param==0);
+
+       // d/dx atan(x) -> 1/(1+x^2)
+       return power::power(_ex1+power::power(x,_ex2), _ex_1);
+}
+
+ex atan_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& arg = seq[0];
+       GINAC_ASSERT(is_a<symbol>(rel.lhs()));
+       // method:
+       // Taylor series where there is no pole or cut falls back to atan_deriv.
+       // There are two branch cuts, one runnig from I up the imaginary axis and
+       // one running from -I down the imaginary axis.  The points I and -I are
+       // poles.
+       // On the branch cuts and the poles series expand
+       //     (log(1+I*x)-log(1-I*x))/(2*I)
+       // instead.
+       const ex arg_pt = arg.subs(rel, subs_options::no_pattern);
+       if (!(I*arg_pt).info(info_flags::real))
+               return basic::series(rel, order, options);
+       if ((I*arg_pt).info(info_flags::real) && abs(I*arg_pt)<_ex1)
+               return basic::series(rel, order, options);
+       // care for the poles, using the defining formula for atan()...
+       if (arg_pt.is_equal(I) || arg_pt.is_equal(-I))
+               return ((log(1+I*arg)-log(1-I*arg))/(2*I)).series(rel, order, options);
+       if (!(options & series_options::suppress_branchcut)) {
+               // method:
+               // This is the branch cut: assemble the primitive series manually and
+               // then add the corresponding complex step function.
+               const symbol& s = ex_to<symbol>(rel.lhs());
+               const ex& point = rel.rhs();
+               const symbol foo;
+               const ex replarg = atan(arg).series(s==foo, order).subs(foo==point, subs_options::no_pattern);
+               ex Order0correction = replarg.op(0)+csgn(arg)*Pi*_ex_1_2;
+               if ((I*arg_pt)<_ex0)
+                       Order0correction += log((I*arg_pt+_ex_1)/(I*arg_pt+_ex1))*I*_ex_1_2;
+               else
+                       Order0correction += log((I*arg_pt+_ex1)/(I*arg_pt+_ex_1))*I*_ex1_2;
+               epvector seq;
+               seq.push_back(expair(Order0correction, _ex0));
+               seq.push_back(expair(Order(_ex1), order));
+               return (replarg - pseries(rel, seq)).series(rel, order);
+       }
+       return basic::series(rel, order, options);
+}
+
+void atan_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\arctan";
+       inherited::do_print(c,level);
+}
+
+//////////
+// inverse tangent (atan2(y,x))
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(atan2_function,
+               print_func<print_latex>(&atan2_function::do_print_latex))
+
+ex atan2_function::eval(int level) const
+{
+       const ex& y = seq[0];
+       const ex& x = seq[1];
+
+       if (y.info(info_flags::numeric) && x.info(info_flags::numeric)) {
+
+               if (y.is_zero()) {
+
+                       // atan(0, 0) -> 0
+                       if (x.is_zero())
+                               return _ex0;
+
+                       // atan(0, x), x real and positive -> 0
+                       if (x.info(info_flags::positive))
+                               return _ex0;
+
+                       // atan(0, x), x real and negative -> -Pi
+                       if (x.info(info_flags::negative))
+                               return _ex_1*Pi;
+               }
+
+               if (x.is_zero()) {
+
+                       // atan(y, 0), y real and positive -> Pi/2
+                       if (y.info(info_flags::positive))
+                               return _ex1_2*Pi;
+
+                       // atan(y, 0), y real and negative -> -Pi/2
+                       if (y.info(info_flags::negative))
+                               return _ex_1_2*Pi;
+               }
+
+               if (y.is_equal(x)) {
+
+                       // atan(y, y), y real and positive -> Pi/4
+                       if (y.info(info_flags::positive))
+                               return _ex1_4*Pi;
+
+                       // atan(y, y), y real and negative -> -3/4*Pi
+                       if (y.info(info_flags::negative))
+                               return numeric(-3, 4)*Pi;
+               }
+
+               if (y.is_equal(-x)) {
+
+                       // atan(y, -y), y real and positive -> 3*Pi/4
+                       if (y.info(info_flags::positive))
+                               return numeric(3, 4)*Pi;
+
+                       // atan(y, -y), y real and negative -> -Pi/4
+                       if (y.info(info_flags::negative))
+                               return _ex_1_4*Pi;
+               }
+
+               // atan(float, float) -> float
+               if (!y.info(info_flags::crational) && !x.info(info_flags::crational))
+                       return atan(ex_to<numeric>(y), ex_to<numeric>(x));
+
+               // atan(real, real) -> atan(y/x) +/- Pi
+               if (y.info(info_flags::real) && x.info(info_flags::real)) {
+                       if (x.info(info_flags::positive))
+                               return atan(y/x);
+                       else if(y.info(info_flags::positive))
+                               return atan(y/x)+Pi;
+                       else
+                               return atan(y/x)-Pi;
+               }
+       }
+
+       return this->hold();
+}    
+
+ex atan2_function::evalf(int level) const
+{
+       const ex& y = seq[0];
+       const ex& x = seq[1];
+       if (is_exactly_a<numeric>(y) && is_exactly_a<numeric>(x))
+               return atan(ex_to<numeric>(y), ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex atan2_function::pderivative(unsigned deriv_param) const
+{
+       const ex& y = seq[0];
+       const ex& x = seq[1];
+       GINAC_ASSERT(deriv_param<2);
+       
+       if (deriv_param==0) {
+               // d/dy atan(y,x)
+               return x*power::power(power::power(x,_ex2)+power::power(y,_ex2),_ex_1);
+       }
+       // d/dx atan(y,x)
+       return -y*power::power(power::power(x,_ex2)+power::power(y,_ex2),_ex_1);
+}
+
+void atan2_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\arctan_2";
+       inherited::do_print(c,level);
+}
+
+//////////
+// hyperbolic sine (trigonometric function)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(sinh_function,
+               print_func<print_latex>(&sinh_function::do_print_latex))
+
+ex sinh_function::eval(int level) const
+{
+       const ex& x = seq[0];
+
+       if (x.info(info_flags::numeric)) {
+
+               // sinh(0) -> 0
+               if (x.is_zero())
+                       return _ex0;        
+
+               // sinh(float) -> float
+               if (!x.info(info_flags::crational))
+                       return sinh(ex_to<numeric>(x));
+
+               // sinh() is odd
+               if (x.info(info_flags::negative))
+                       return -sinh(-x);
+       }
+       
+       if ((x/Pi).info(info_flags::numeric) &&
+               ex_to<numeric>(x/Pi).real().is_zero())  // sinh(I*x) -> I*sin(x)
+               return I*sin(x/I);
+       
+       const ex& t = x.op(0);
+       if (is_exactly_a<asinh_function>(x)) {
+               // sinh(asinh(x)) -> x
+               return t;
+       } else if (is_exactly_a<acosh_function>(x)) {
+               // sinh(acosh(x)) -> sqrt(x-1) * sqrt(x+1)
+               return sqrt(t-_ex1)*sqrt(t+_ex1);
+       } else if (is_exactly_a<atanh_function>(x)) {
+               // sinh(atanh(x)) -> x/sqrt(1-x^2)
+               return t*power::power(_ex1-power::power(t,_ex2),_ex_1_2);
+       }
+       
+       return this->hold();
+}
+
+ex sinh_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x))
+               return sinh(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex sinh_function::pderivative(unsigned deriv_param) const
+{
+       const ex& x = seq[0];
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx sinh(x) -> cosh(x)
+       return cosh(x);
+}
+
+void sinh_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\arcsin";
+       inherited::do_print(c,level);
+}
+
+//////////
+// hyperbolic cosine (trigonometric function)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(cosh_function,
+               print_func<print_latex>(&cosh_function::do_print_latex))
+
+ex cosh_function::eval(int level) const
+{
+       const ex& x = seq[0];
+
+       if (x.info(info_flags::numeric)) {
+
+               // cosh(0) -> 1
+               if (x.is_zero())
+                       return _ex1;
+
+               // cosh(float) -> float
+               if (!x.info(info_flags::crational))
+                       return cosh(ex_to<numeric>(x));
+
+               // cosh() is even
+               if (x.info(info_flags::negative))
+                       return cosh(-x);
+       }
+       
+       if ((x/Pi).info(info_flags::numeric) &&
+               ex_to<numeric>(x/Pi).real().is_zero())  // cosh(I*x) -> cos(x)
+               return cos(x/I);
+       
+       if (is_exactly_a<acosh_function>(x)) {
+               // cosh(acosh(x)) -> x
+               return x.op(0);
+       } else if (is_exactly_a<asinh_function>(x)) {
+               // cosh(asinh(x)) -> sqrt(1+x^2)
+               return sqrt(_ex1+power::power(x.op(0),_ex2));
+       } else if (is_exactly_a<atanh_function>(x)) {
+               // cosh(atanh(x)) -> 1/sqrt(1-x^2)
+               return power::power(_ex1-power::power(x.op(0),_ex2),_ex_1_2);
+       }
+       
+       return this->hold();
+}
+
+ex cosh_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+
+       if (is_exactly_a<numeric>(x))
+               return cosh(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex cosh_function::pderivative(unsigned deriv_param) const
+{
+       const ex& x = seq[0];
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx cosh(x) -> sinh(x)
+       return sinh(x);
+}
+
+void cosh_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\arccos";
+       inherited::do_print(c,level);
+}
+
+//////////
+// hyperbolic tangent (trigonometric function)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(tanh_function,
+               print_func<print_latex>(&tanh_function::do_print_latex))
+
+ex tanh_function::eval(int level) const
+{
+       const ex& x = seq[0];
+
+       if (x.info(info_flags::numeric)) {
+
+               // tanh(0) -> 0
+               if (x.is_zero())
+                       return _ex0;
+
+               // tanh(float) -> float
+               if (!x.info(info_flags::crational))
+                       return tanh(ex_to<numeric>(x));
+
+               // tanh() is odd
+               if (x.info(info_flags::negative))
+                       return -tanh(-x);
+       }
+       
+       if ((x/Pi).info(info_flags::numeric) &&
+               ex_to<numeric>(x/Pi).real().is_zero())  // tanh(I*x) -> I*tan(x);
+               return I*tan(x/I);
+       
+       if (is_exactly_a<atanh_function>(x)) {
+               // tanh(atanh(x)) -> x
+               return x.op(0);
+       } else if (is_exactly_a<asinh_function>(x)) {
+               // tanh(asinh(x)) -> x/sqrt(1+x^2)
+               const ex& t = x.op(0);
+               return t*power::power(_ex1+power::power(t,_ex2),_ex_1_2);
+       } else if (is_exactly_a<acosh_function>(x)) {
+               // tanh(acosh(x)) -> sqrt(x-1)*sqrt(x+1)/x
+               const ex& t = x.op(0);
+               return sqrt(t-_ex1)*sqrt(t+_ex1)*power::power(t,_ex_1);
+       }
+       
+       return this->hold();
+}
+
+ex tanh_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+       if (is_exactly_a<numeric>(x))
+               return tanh(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex tanh_function::pderivative(unsigned deriv_param) const
+{
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx tanh(x) -> 1-tanh(x)^2
+       return _ex1-power::power(tanh(seq[0]),_ex2);
+}
+
+ex tanh_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& x = seq[0];
+
+       GINAC_ASSERT(is_a<symbol>(rel.lhs()));
+       // method:
+       // Taylor series where there is no pole falls back to tanh_deriv.
+       // On a pole simply expand sinh(x)/cosh(x).
+       const ex x_pt = x.subs(rel, subs_options::no_pattern);
+       if (!(2*I*x_pt/Pi).info(info_flags::odd))
+               return basic::series(rel, order, options);
+       // if we got here we have to care for a simple pole
+       return (sinh(x)/cosh(x)).series(rel, order, options);
+}
+
+void tanh_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\arctan";
+       inherited::do_print(c,level);
+}
+
+//////////
+// inverse hyperbolic sine (trigonometric function)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(asinh_function,
+               print_func<print_latex>(&asinh_function::do_print_latex))
+
+ex asinh_function::eval(int level) const
+{
+       const ex& x = seq[0];
+
+       if (x.info(info_flags::numeric)) {
+
+               // asinh(0) -> 0
+               if (x.is_zero())
+                       return _ex0;
+
+               // asinh(float) -> float
+               if (!x.info(info_flags::crational))
+                       return asinh(ex_to<numeric>(x));
+
+               // asinh() is odd
+               if (x.info(info_flags::negative))
+                       return -asinh(-x);
+       }
+       
+       return this->hold();
+}
+
+ex asinh_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+
+       if (is_exactly_a<numeric>(x))
+               return asinh(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex asinh_function::pderivative(unsigned deriv_param) const
+{
+       const ex& x = seq[0];
+
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx asinh(x) -> 1/sqrt(1+x^2)
+       return power::power(_ex1+power::power(x,_ex2),_ex_1_2);
+}
+
+void asinh_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\arcsinh";
+       inherited::do_print(c,level);
+}
+
+//////////
+// inverse hyperbolic cosine (trigonometric function)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(acosh_function,
+               print_func<print_latex>(&acosh_function::do_print_latex))
+
+ex acosh_function::eval(int level) const
+{
+       const ex& x = seq[0];
+
+       if (x.info(info_flags::numeric)) {
+
+               // acosh(0) -> Pi*I/2
+               if (x.is_zero())
+                       return Pi*I*numeric(1,2);
+
+               // acosh(1) -> 0
+               if (x.is_equal(_ex1))
+                       return _ex0;
+
+               // acosh(-1) -> Pi*I
+               if (x.is_equal(_ex_1))
+                       return Pi*I;
+
+               // acosh(float) -> float
+               if (!x.info(info_flags::crational))
+                       return acosh(ex_to<numeric>(x));
+
+               // acosh(-x) -> Pi*I-acosh(x)
+               if (x.info(info_flags::negative))
+                       return Pi*I-acosh(-x);
+       }
+       
+       return this->hold();
+}
+
+ex acosh_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+
+       if (is_exactly_a<numeric>(x))
+               return acosh(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex acosh_function::pderivative(unsigned deriv_param) const
+{
+       const ex& x = seq[0];
+
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx acosh(x) -> 1/(sqrt(x-1)*sqrt(x+1))
+       return power::power(x+_ex_1,_ex_1_2)*power::power(x+_ex1,_ex_1_2);
+}
+
+void acosh_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\arccosh";
+       inherited::do_print(c,level);
+}
+
+//////////
+// inverse hyperbolic tangent (trigonometric function)
+//////////
+
+GINAC_IMPLEMENT_FUNCTION_OPT(atanh_function,
+               print_func<print_latex>(&atanh_function::do_print_latex))
+
+ex atanh_function::eval(int level) const
+{
+       const ex& x = seq[0];
+       if (x.info(info_flags::numeric)) {
+
+               // atanh(0) -> 0
+               if (x.is_zero())
+                       return _ex0;
+
+               // atanh({+|-}1) -> throw
+               if (x.is_equal(_ex1) || x.is_equal(_ex_1))
+                       throw (pole_error("atanh_eval(): logarithmic pole",0));
+
+               // atanh(float) -> float
+               if (!x.info(info_flags::crational))
+                       return atanh(ex_to<numeric>(x));
+
+               // atanh() is odd
+               if (x.info(info_flags::negative))
+                       return -atanh(-x);
+       }
+       
+       return this->hold();
+}
+
+ex atanh_function::evalf(int level) const
+{
+       const ex& x = seq[0];
+
+       if (is_exactly_a<numeric>(x))
+               return atanh(ex_to<numeric>(x));
+       
+       return this->hold();
+}
+
+ex atanh_function::pderivative(unsigned deriv_param) const
+{
+       const ex& x = seq[0];
+       GINAC_ASSERT(deriv_param==0);
+       
+       // d/dx atanh(x) -> 1/(1-x^2)
+       return power::power(_ex1-power::power(x,_ex2),_ex_1);
+}
+
+ex atanh_function::series(const relational& rel, int order, unsigned options) const
+{
+       const ex& arg = seq[0];
+
+       GINAC_ASSERT(is_a<symbol>(rel.lhs()));
+       // method:
+       // Taylor series where there is no pole or cut falls back to atanh_deriv.
+       // There are two branch cuts, one runnig from 1 up the real axis and one
+       // one running from -1 down the real axis.  The points 1 and -1 are poles
+       // On the branch cuts and the poles series expand
+       //     (log(1+x)-log(1-x))/2
+       // instead.
+       const ex arg_pt = arg.subs(rel, subs_options::no_pattern);
+       if (!(arg_pt).info(info_flags::real))
+               return basic::series(rel, order, options);
+       if ((arg_pt).info(info_flags::real) && abs(arg_pt)<_ex1)
+               return basic::series(rel, order, options);
+       // care for the poles, using the defining formula for atanh()...
+       if (arg_pt.is_equal(_ex1) || arg_pt.is_equal(_ex_1))
+               return ((log(_ex1+arg)-log(_ex1-arg))*_ex1_2).series(rel, order, options);
+       // ...and the branch cuts (the discontinuity at the cut being just I*Pi)
+       if (!(options & series_options::suppress_branchcut)) {
+               // method:
+               // This is the branch cut: assemble the primitive series manually and
+               // then add the corresponding complex step function.
+               const symbol &s = ex_to<symbol>(rel.lhs());
+               const ex &point = rel.rhs();
+               const symbol foo;
+               const ex replarg = atanh(arg).series(s==foo, order).subs(foo==point, subs_options::no_pattern);
+               ex Order0correction = replarg.op(0)+csgn(I*arg)*Pi*I*_ex1_2;
+               if (arg_pt<_ex0)
+                       Order0correction += log((arg_pt+_ex_1)/(arg_pt+_ex1))*_ex1_2;
+               else
+                       Order0correction += log((arg_pt+_ex1)/(arg_pt+_ex_1))*_ex_1_2;
+               epvector seq;
+               seq.push_back(expair(Order0correction, _ex0));
+               seq.push_back(expair(Order(_ex1), order));
+               return (replarg - pseries(rel, seq)).series(rel, order);
+       }
+       return basic::series(rel, order, options);
+}
+
+void atanh_function::do_print_latex(const print_context& c, unsigned level) const
+{
+       c.s << "\\arctanh";
+       inherited::do_print(c,level);
+}
+
+} // namespace GiNaC
diff --git a/ginac/inifcns_trig.h b/ginac/inifcns_trig.h
new file mode 100644 (file)
index 0000000..e5baf10
--- /dev/null
@@ -0,0 +1,258 @@
+/** @file inifcns_trig.h
+ *
+ *  Interface to GiNaC's initially known trigonometric functions. */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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
+ */
+
+#ifndef __GINAC_INIFCNS_TRIG_H__
+#define __GINAC_INIFCNS_TRIG_H__
+
+#include "ex.h"
+#include "function.h"
+
+namespace GiNaC {
+
+/** Sine. */
+
+class sin_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(sin_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline sin_function sin(const T1& x1) { return sin_function(x1); }
+inline sin_function sin(double x1);
+inline sin_function sin(float x1);
+
+/** Cosine. */
+
+class cos_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(cos_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline cos_function cos(const T1& x1) { return cos_function(x1); }
+inline cos_function cos(double x1);
+inline cos_function cos(float x1);
+
+/** Tangent. */
+
+class tan_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(tan_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+       virtual ex series(const relational & r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline tan_function tan(const T1& x1) { return tan_function(x1); }
+inline tan_function tan(double x1);
+inline tan_function tan(float x1);
+
+/** Inverse sine (arc sine). */
+
+class asin_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(asin_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline asin_function asin(const T1& x1) { return asin_function(x1); }
+inline asin_function asin(double x1);
+inline asin_function asin(float x1);
+
+/** Inverse cosine (arc cosine). */
+
+class acos_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(acos_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline acos_function acos(const T1& x1) { return acos_function(x1); }
+inline acos_function acos(double x1);
+inline acos_function acos(float x1);
+
+/** Inverse tangent (arc tangent). */
+
+class atan_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(atan_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+       virtual ex series(const relational & r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline atan_function atan(const T1& x1) { return atan_function(x1); }
+inline atan_function atan(double x1);
+inline atan_function atan(float x1);
+
+/** Inverse tangent with two arguments. */
+
+class atan2_function : public function
+{
+       GINAC_DECLARE_FUNCTION_2P(atan2_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1, typename T2> inline atan2_function atan2(const T1& x1, const T2& x2) { return atan2_function(x1, x2); }
+inline atan2_function atan2(double x1, double x2);
+inline atan2_function atan2(float x1, float x2);
+
+/** Hyperbolic Sine. */
+
+class sinh_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(sinh_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline sinh_function sinh(const T1& x1) { return sinh_function(x1); }
+inline sinh_function sinh(double x1);
+inline sinh_function sinh(float x1);
+
+/** Hyperbolic Cosine. */
+
+class cosh_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(cosh_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline cosh_function cosh(const T1& x1) { return cosh_function(x1); }
+inline cosh_function cosh(double x1);
+inline cosh_function cosh(float x1);
+
+/** Hyperbolic Tangent. */
+
+class tanh_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(tanh_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+       virtual ex series(const relational & r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline tanh_function tanh(const T1& x1) { return tanh_function(x1); }
+inline tanh_function tanh(double x1);
+inline tanh_function tanh(float x1);
+
+/** Inverse hyperbolic Sine (area hyperbolic sine). */
+
+class asinh_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(asinh_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline asinh_function asinh(const T1& x1) { return asinh_function(x1); }
+inline asinh_function asinh(double x1);
+inline asinh_function asinh(float x1);
+
+/** Inverse hyperbolic Cosine (area hyperbolic cosine). */
+
+class acosh_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(acosh_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline acosh_function acosh(const T1& x1) { return acosh_function(x1); }
+inline acosh_function acosh(double x1);
+inline acosh_function acosh(float x1);
+
+/** Inverse hyperbolic Tangent (area hyperbolic tangent). */
+
+class atanh_function : public function
+{
+       GINAC_DECLARE_FUNCTION_1P(atanh_function)
+public:
+       virtual ex eval(int level = 0) const;
+       virtual ex evalf(int level = 0) const;
+       virtual ex pderivative(unsigned diff_param) const;
+       virtual ex series(const relational & r, int order, unsigned options = 0) const;
+protected:
+       void do_print_latex(const print_context& c, unsigned level) const;
+};
+
+template<typename T1> inline atanh_function atanh(const T1& x1) { return atanh_function(x1); }
+inline atanh_function atanh(double x1);
+inline atanh_function atanh(float x1);
+
+} // namespace GiNaC
+
+#endif // ifndef __GINAC_INIFCNS_TRIG_H__
diff --git a/ginac/input_parser.yy b/ginac/input_parser.yy
new file mode 100644 (file)
index 0000000..a47f980
--- /dev/null
@@ -0,0 +1,207 @@
+/** @file input_parser.yy
+ *
+ *  Input grammar definition for reading expressions.
+ *  This file must be processed with yacc/bison. */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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
+ */
+
+
+/*
+ *  Definitions
+ */
+
+%{
+#include <stdexcept>
+
+#include "ex.h"
+#include "input_lexer.h"
+#include "relational.h"
+#include "operators.h"
+#include "symbol.h"
+#include "lst.h"
+#include "power.h"
+#include "exprseq.h"
+#include "idx.h"
+#include "indexed.h"
+#include "matrix.h"
+#include "inifcns.h"
+
+namespace GiNaC {
+
+#define YYERROR_VERBOSE 1
+
+// Parsed output expression
+ex parsed_ex;
+
+// Last error message returned by parser
+static std::string parser_error;
+
+// Prototypes
+ex attach_index(const ex & base, ex i, bool covariant);
+%}
+
+/* Tokens (T_LITERAL means a literal value returned by the parser, but not
+   of class numeric or symbol (e.g. a constant or the FAIL object)) */
+%token T_EOF T_NUMBER T_SYMBOL T_LITERAL T_DIGITS T_EQUAL T_NOTEQ T_LESSEQ T_GREATEREQ
+
+/* Operator precedence and associativity */
+%right '='
+%left T_EQUAL T_NOTEQ
+%left '<' '>' T_LESSEQ T_GREATEREQ
+%left '+' '-'
+%left '*' '/' '%'
+%nonassoc NEG
+%right '^'
+%left '.' '~'
+%nonassoc '!'
+
+%start input
+
+
+/*
+ *  Grammar rules
+ */
+
+%%
+input  : exp T_EOF {
+               try {
+                       parsed_ex = $1;
+                       YYACCEPT;
+               } catch (std::exception &err) {
+                       parser_error = err.what();
+                       YYERROR;
+               }
+       }
+       ;
+
+exp    : T_NUMBER              {$$ = $1;}
+       | T_SYMBOL {
+               if (is_lexer_symbol_predefined($1))
+                       $$ = $1.eval();
+               else
+                       throw (std::runtime_error("unknown symbol '" + get_symbol_name($1) + "'"));
+       }
+       | T_LITERAL             {$$ = $1;}
+       | T_DIGITS              {$$ = $1;}
+       | T_SYMBOL '(' exprseq ')' {
+               std::string n = get_symbol_name($1);
+               if (n == "sqrt") {
+                       if ($3.nops() != 1)
+                               throw (std::runtime_error("too many arguments to sqrt()"));
+                       $$ = sqrt($3.op(0));
+               } else {
+                       factory_p p = find_func_factory(n+"_function");
+                       // exprseq -> exvector
+                       const exprseq& in = ex_to<exprseq>($3);
+                       exvector out;
+                       for (exprseq::const_iterator it = in.begin(); it != in.end(); ++it) {
+                               out.push_back(*it);
+                       }
+                       $$ = (*p)(out);
+//                     $$ = n(ex_to<exprseq>($3));
+//TODO
+//                     unsigned i = function::find_function(n, $3.nops());
+//                     $$ = function(i, ex_to<exprseq>($3)).eval(1);
+               }
+       }
+       | exp T_EQUAL exp       {$$ = $1 == $3;}
+       | exp T_NOTEQ exp       {$$ = $1 != $3;}
+       | exp '<' exp           {$$ = $1 < $3;}
+       | exp T_LESSEQ exp      {$$ = $1 <= $3;}
+       | exp '>' exp           {$$ = $1 > $3;}
+       | exp T_GREATEREQ exp   {$$ = $1 >= $3;}
+       | exp '+' exp           {$$ = $1 + $3;}
+       | exp '-' exp           {$$ = $1 - $3;}
+       | exp '*' exp           {$$ = $1 * $3;}
+       | exp '/' exp           {$$ = $1 / $3;}
+       | '-' exp %prec NEG     {$$ = -$2;}
+       | '+' exp %prec NEG     {$$ = $2;}
+       | exp '^' exp           {$$ = pow($1, $3);}
+       | exp '.' exp           {$$ = attach_index($1, $3, true);}
+       | exp '~' exp           {$$ = attach_index($1, $3, false);}
+       | exp '!'                       {$$ = factorial($1);}
+       | '(' exp ')'           {$$ = $2;}
+       | '{' list_or_empty '}' {$$ = $2;}
+       | '[' matrix ']'        {$$ = lst_to_matrix(ex_to<lst>($2));}
+       ;
+
+exprseq        : exp                   {$$ = exprseq($1);}
+       | exprseq ',' exp       {exprseq es(ex_to<exprseq>($1)); $$ = es.append($3);}
+       ;
+
+list_or_empty: /* empty */     {$$ = *new lst;}
+       | list                  {$$ = $1;}
+       ;
+
+list   : exp                   {$$ = lst($1);}
+       | list ',' exp          {lst l(ex_to<lst>($1)); $$ = l.append($3);}
+       ;
+
+matrix : '[' row ']'           {$$ = lst($2);}
+       | matrix ',' '[' row ']' {lst l(ex_to<lst>($1)); $$ = l.append($4);}
+       ;
+
+row    : exp                   {$$ = lst($1);}
+       | row ',' exp           {lst l(ex_to<lst>($1)); $$ = l.append($3);}
+       ;
+
+
+/*
+ *  Routines
+ */
+
+%%
+// Attach index to expression
+ex attach_index(const ex & base, ex i, bool covariant)
+{
+       // Toggle index variance if necessary
+       if (is_a<varidx>(i)) {
+               const varidx &vi = ex_to<varidx>(i);
+               if (vi.is_covariant() != covariant)
+                       i = vi.toggle_variance();
+       } else if (!covariant)
+               throw (std::runtime_error("index '" + get_symbol_name(i) + "' is not a varidx and cannot be contravariant"));
+
+       // Add index to an existing indexed object, or create a new indexed
+       // object if there are no indices yet
+       if (is_a<indexed>(base)) {
+               const ex &b = base.op(0);
+               exvector iv;
+               for (unsigned n=1; n<base.nops(); n++)
+                       iv.push_back(base.op(n));
+               iv.push_back(i);
+               return indexed(b, iv);
+       } else
+               return indexed(base, i);
+}
+
+// Get last error encountered by parser
+std::string get_parser_error(void)
+{
+       return parser_error;
+}
+
+} // namespace GiNaC
+
+// Error print routine (store error string in parser_error)
+int ginac_yyerror(char *s)
+{
+       GiNaC::parser_error = std::string(s) + " at " + std::string(ginac_yytext);
+       return 0;
+}
diff --git a/ginac/integral.cpp b/ginac/integral.cpp
new file mode 100644 (file)
index 0000000..2e81a69
--- /dev/null
@@ -0,0 +1,478 @@
+/** @file integral.cpp
+ *
+ *  Implementation of GiNaC's symbolic  integral. */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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 "integral.h"
+#include "numeric.h"
+#include "symbol.h"
+#include "add.h"
+#include "mul.h"
+#include "power.h"
+#include "inifcns.h"
+#include "inifcns_exp.h"
+#include "wildcard.h"
+#include "archive.h"
+#include "registrar.h"
+#include "utils.h"
+#include "operators.h"
+#include "relational.h"
+
+using namespace std;
+
+namespace GiNaC {
+
+GINAC_IMPLEMENT_REGISTERED_CLASS_OPT(integral, basic,
+  print_func<print_dflt>(&integral::do_print).
+  print_func<print_latex>(&integral::do_print_latex))
+
+
+//////////
+// default constructor
+//////////
+
+integral::integral()
+               : inherited(&integral::tinfo_static),
+               x((new symbol())->setflag(status_flags::dynallocated))
+{}
+
+//////////
+// other constructors
+//////////
+
+// public
+
+integral::integral(const ex & x_, const ex & a_, const ex & b_, const ex & f_)
+               : inherited(&integral::tinfo_static), x(x_), a(a_), b(b_), f(f_)
+{
+       if (!is_a<symbol>(x)) {
+               throw(std::invalid_argument("first argument of integral must be of type symbol"));
+       }
+}
+
+//////////
+// archiving
+//////////
+
+integral::integral(const archive_node & n, lst & sym_lst) : inherited(n, sym_lst)
+{
+       n.find_ex("x", x, sym_lst);
+       n.find_ex("a", a, sym_lst);
+       n.find_ex("b", b, sym_lst);
+       n.find_ex("f", f, sym_lst);
+}
+
+void integral::archive(archive_node & n) const
+{
+       inherited::archive(n);
+       n.add_ex("x", x);
+       n.add_ex("a", a);
+       n.add_ex("b", b);
+       n.add_ex("f", f);
+}
+
+DEFAULT_UNARCHIVE(integral)
+
+//////////
+// functions overriding virtual functions from base classes
+//////////
+
+void integral::do_print(const print_context & c, unsigned level) const
+{
+       c.s << "integral(";
+       x.print(c);
+       c.s << ",";
+       a.print(c);
+       c.s << ",";
+       b.print(c);
+       c.s << ",";
+       f.print(c);
+       c.s << ")";
+}
+
+void integral::do_print_latex(const print_latex & c, unsigned level) const
+{
+       string varname = ex_to<symbol>(x).get_name();
+       if (level > precedence())
+               c.s << "\\left(";
+       c.s << "\\int_{";
+       a.print(c);
+       c.s << "}^{";
+       b.print(c);
+       c.s << "} d";
+       if (varname.size() > 1)
+               c.s << "\\," << varname << "\\:";
+       else
+               c.s << varname << "\\,";
+       f.print(c,precedence());
+       if (level > precedence())
+               c.s << "\\right)";
+}
+
+int integral::compare_same_type(const basic & other) const
+{
+       GINAC_ASSERT(is_exactly_a<integral>(other));
+       const integral &o = static_cast<const integral &>(other);
+
+       int cmpval = x.compare(o.x);
+       if (cmpval)
+               return cmpval;
+       cmpval = a.compare(o.a);
+       if (cmpval)
+               return cmpval;
+       cmpval = b.compare(o.b);
+       if (cmpval)
+               return cmpval;
+       return f.compare(o.f);
+}
+
+ex integral::eval(int level) const
+{
+       if ((level==1) && (flags & status_flags::evaluated))
+               return *this;
+       if (level == -max_recursion_level)
+               throw(std::runtime_error("max recursion level reached"));
+
+       ex eintvar = (level==1) ? x : x.eval(level-1);
+       ex ea      = (level==1) ? a : a.eval(level-1);
+       ex eb      = (level==1) ? b : b.eval(level-1);
+       ex ef      = (level==1) ? f : f.eval(level-1);
+
+       if (!ef.has(eintvar) && !haswild(ef))
+               return eb*ef-ea*ef;
+
+       if (ea==eb)
+               return _ex0;
+
+       if (are_ex_trivially_equal(eintvar,x) && are_ex_trivially_equal(ea,a)
+                       && are_ex_trivially_equal(eb,b) && are_ex_trivially_equal(ef,f))
+               return this->hold();
+       return (new integral(eintvar, ea, eb, ef))
+               ->setflag(status_flags::dynallocated | status_flags::evaluated);
+}
+
+ex integral::evalf(int level) const
+{
+       ex ea;
+       ex eb;
+       ex ef;
+
+       if (level==1) {
+               ea = a;
+               eb = b;
+               ef = f;
+       } else if (level == -max_recursion_level) {
+               throw(runtime_error("max recursion level reached"));
+       } else {
+               ea = a.evalf(level-1);
+               eb = b.evalf(level-1);
+               ef = f.evalf(level-1);
+       }
+
+       // 12.34 is just an arbitrary number used to check whether a number
+       // results after subsituting a number for the integration variable.
+       if (is_exactly_a<numeric>(ea) && is_exactly_a<numeric>(eb) 
+                       && is_exactly_a<numeric>(ef.subs(x==12.34).evalf())) {
+               try {
+                       return adaptivesimpson(x, ea, eb, ef);
+               } catch (runtime_error &rte) {}
+       }
+
+       if (are_ex_trivially_equal(a, ea) && are_ex_trivially_equal(b, eb)
+                               && are_ex_trivially_equal(f, ef))
+                       return *this;
+               else
+                       return (new integral(x, ea, eb, ef))
+                               ->setflag(status_flags::dynallocated);
+}
+
+int integral::max_integration_level = 15;
+ex integral::relative_integration_error = 1e-8;
+
+ex subsvalue(const ex & var, const ex & value, const ex & fun)
+{
+       ex result = fun.subs(var==value).evalf();
+       if (is_a<numeric>(result))
+               return result;
+       throw logic_error("integrand does not evaluate to numeric");
+}
+
+struct error_and_integral
+{
+       error_and_integral(const ex &err, const ex &integ)
+               :error(err), integral(integ){}
+       ex error;
+       ex integral;
+};
+
+struct error_and_integral_is_less
+{
+       bool operator()(const error_and_integral &e1,const error_and_integral &e2)
+       {
+               int c = e1.integral.compare(e2.integral);
+               if(c < 0)
+                       return true;
+               if(c > 0)
+                       return false;
+               return ex_is_less()(e1.error, e2.error);
+       }
+};
+
+typedef map<error_and_integral, ex, error_and_integral_is_less> lookup_map;
+
+/** Numeric integration routine based upon the "Adaptive Quadrature" one
+  * in "Numerical Analysis" by Burden and Faires. Parameters are integration
+  * variable, left boundary, right boundary, function to be integrated and
+  * the relative integration error. The function should evalf into a number
+  * after substituting the integration variable by a number. Another thing
+  * to note is that this implementation is no good at integrating functions
+  * with discontinuities. */
+ex adaptivesimpson(const ex & x, const ex & a_in, const ex & b_in, const ex & f, const ex & error)
+{
+       // Check whether boundaries and error are numbers.
+       ex a = is_exactly_a<numeric>(a_in) ? a_in : a_in.evalf();
+       ex b = is_exactly_a<numeric>(b_in) ? b_in : b_in.evalf();
+       if(!is_exactly_a<numeric>(a) || !is_exactly_a<numeric>(b))
+               throw std::runtime_error("For numerical integration the boundaries of the integral should evalf into numbers.");
+       if(!is_exactly_a<numeric>(error))
+               throw std::runtime_error("For numerical integration the error should be a number.");
+
+       // Use lookup table to be potentially much faster.
+       static lookup_map lookup;
+       static symbol ivar("ivar");
+       ex lookupex = integral(ivar,a,b,f.subs(x==ivar));
+       lookup_map::iterator emi = lookup.find(error_and_integral(error, lookupex));
+       if (emi!=lookup.end())
+               return emi->second;
+
+       ex app = 0;
+       int i = 1;
+       exvector avec(integral::max_integration_level+1);
+       exvector hvec(integral::max_integration_level+1);
+       exvector favec(integral::max_integration_level+1);
+       exvector fbvec(integral::max_integration_level+1);
+       exvector fcvec(integral::max_integration_level+1);
+       exvector svec(integral::max_integration_level+1);
+       exvector errorvec(integral::max_integration_level+1);
+       vector<int> lvec(integral::max_integration_level+1);
+
+       avec[i] = a;
+       hvec[i] = (b-a)/2;
+       favec[i] = subsvalue(x, a, f);
+       fcvec[i] = subsvalue(x, a+hvec[i], f);
+       fbvec[i] = subsvalue(x, b, f);
+       svec[i] = hvec[i]*(favec[i]+4*fcvec[i]+fbvec[i])/3;
+       lvec[i] = 1;
+       errorvec[i] = error*svec[i];
+
+       while (i>0) {
+               ex fd = subsvalue(x, avec[i]+hvec[i]/2, f);
+               ex fe = subsvalue(x, avec[i]+3*hvec[i]/2, f);
+               ex s1 = hvec[i]*(favec[i]+4*fd+fcvec[i])/6;
+               ex s2 = hvec[i]*(fcvec[i]+4*fe+fbvec[i])/6;
+               ex nu1 = avec[i];
+               ex nu2 = favec[i];
+               ex nu3 = fcvec[i];
+               ex nu4 = fbvec[i];
+               ex nu5 = hvec[i];
+               // hopefully prevents a crash if the function is zero sometimes.
+               ex nu6 = max(errorvec[i], (s1+s2)*error);
+               ex nu7 = svec[i];
+               int nu8 = lvec[i];
+               --i;
+               if (abs(ex_to<numeric>(s1+s2-nu7)) <= nu6)
+                       app+=(s1+s2);
+               else {
+                       if (nu8>=integral::max_integration_level)
+                               throw runtime_error("max integration level reached");
+                       ++i;
+                       avec[i] = nu1+nu5;
+                       favec[i] = nu3;
+                       fcvec[i] = fe;
+                       fbvec[i] = nu4;
+                       hvec[i] = nu5/2;
+                       errorvec[i]=nu6/2;
+                       svec[i] = s2;
+                       lvec[i] = nu8+1;
+                       ++i;
+                       avec[i] = nu1;
+                       favec[i] = nu2;
+                       fcvec[i] = fd;
+                       fbvec[i] = nu3;
+                       hvec[i] = hvec[i-1];
+                       errorvec[i]=errorvec[i-1];
+                       svec[i] = s1;
+                       lvec[i] = lvec[i-1];
+               }
+       }
+
+       lookup[error_and_integral(error, lookupex)]=app;
+       return app;
+}
+
+int integral::degree(const ex & s) const
+{
+       return ((b-a)*f).degree(s);
+}
+
+int integral::ldegree(const ex & s) const
+{
+       return ((b-a)*f).ldegree(s);
+}
+
+ex integral::eval_ncmul(const exvector & v) const
+{
+       return f.eval_ncmul(v);
+}
+
+size_t integral::nops() const
+{
+       return 4;
+}
+
+ex integral::op(size_t i) const
+{
+       GINAC_ASSERT(i<4);
+
+       switch (i) {
+               case 0:
+                       return x;
+               case 1:
+                       return a;
+               case 2:
+                       return b;
+               case 3:
+                       return f;
+               default:
+                       throw (std::out_of_range("integral::op() out of range"));
+       }
+}
+
+ex & integral::let_op(size_t i)
+{
+       ensure_if_modifiable();
+       switch (i) {
+               case 0:
+                       return x;
+               case 1:
+                       return a;
+               case 2:
+                       return b;
+               case 3:
+                       return f;
+               default:
+                       throw (std::out_of_range("integral::let_op() out of range"));
+       }
+}
+
+ex integral::expand(unsigned options) const
+{
+       if (options==0 && (flags & status_flags::expanded))
+               return *this;
+
+       ex newa = a.expand(options);
+       ex newb = b.expand(options);
+       ex newf = f.expand(options);
+
+       if (is_a<add>(newf)) {
+               exvector v;
+               v.reserve(newf.nops());
+               for (size_t i=0; i<newf.nops(); ++i)
+                       v.push_back(integral(x, newa, newb, newf.op(i)).expand(options));
+               return ex(add(v)).expand(options);
+       }
+
+       if (is_a<mul>(newf)) {
+               ex prefactor = 1;
+               ex rest = 1;
+               for (size_t i=0; i<newf.nops(); ++i)
+                       if (newf.op(i).has(x))
+                               rest *= newf.op(i);
+                       else
+                               prefactor *= newf.op(i);
+               if (prefactor != 1)
+                       return (prefactor*integral(x, newa, newb, rest)).expand(options);
+       }
+
+       if (are_ex_trivially_equal(a, newa) && are_ex_trivially_equal(b, newb)
+                       && are_ex_trivially_equal(f, newf)) {
+               if (options==0)
+                       this->setflag(status_flags::expanded);
+               return *this;
+       }
+
+       const basic & newint = (new integral(x, newa, newb, newf))
+               ->setflag(status_flags::dynallocated);
+       if (options == 0)
+               newint.setflag(status_flags::expanded);
+       return newint;
+}
+
+ex integral::derivative(const symbol & s) const
+{
+       if (s==x)
+               throw(logic_error("differentiation with respect to dummy variable"));
+       return b.diff(s)*f.subs(x==b)-a.diff(s)*f.subs(x==a)+integral(x, a, b, f.diff(s));
+}
+
+unsigned integral::return_type() const
+{
+       return f.return_type();
+}
+
+tinfo_t integral::return_type_tinfo() const
+{
+       return f.return_type_tinfo();
+}
+
+ex integral::conjugate() const
+{
+       ex conja = a.conjugate();
+       ex conjb = b.conjugate();
+       ex conjf = f.conjugate().subs(x.conjugate()==x);
+
+       if (are_ex_trivially_equal(a, conja) && are_ex_trivially_equal(b, conjb)
+                       && are_ex_trivially_equal(f, conjf))
+               return *this;
+
+       return (new integral(x, conja, conjb, conjf))
+               ->setflag(status_flags::dynallocated);
+}
+
+ex integral::eval_integ() const
+{
+       if (!(flags & status_flags::expanded))
+               return this->expand().eval_integ();
+       
+       if (f==x)
+               return b*b/2-a*a/2;
+       if (is_a<power>(f) && f.op(0)==x) {
+               if (f.op(1)==-1)
+                       return log(b/a);
+               if (!f.op(1).has(x)) {
+                       ex primit = power(x,f.op(1)+1)/(f.op(1)+1);
+                       return primit.subs(x==b)-primit.subs(x==a);
+               }
+       }
+
+       return *this;
+}
+
+} // namespace GiNaC
index bacacad8889a4199c7a07576470903f6586277e7..83b088b663006eafb707e904487531966c27560c 100644 (file)
@@ -3,7 +3,7 @@
  *  Implementation of symbolic matrices */
 
 /*
- *  GiNaC Copyright (C) 1999 Johannes Gutenberg University Mainz, Germany
+ *  GiNaC Copyright (C) 1999-2006 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
  *
  *  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  */
 
+#include <string>
+#include <iostream>
+#include <sstream>
 #include <algorithm>
+#include <map>
 #include <stdexcept>
 
 #include "matrix.h"
-#include "debugmsg.h"
+
+#include "relational.h"
+#include "numeric.h"
+#include "lst.h"
+#include "idx.h"
+#include "indexed.h"
+#include "add.h"
+#include "power.h"
+#include "symbol.h"
+#include "operators.h"
+#include "normal.h"
+#include "archive.h"
+#include "utils.h"
 
 namespace GiNaC {
 
+GINAC_IMPLEMENT_REGISTERED_CLASS_OPT(matrix, basic,
+  print_func<print_context>(&matrix::do_print).
+  print_func<print_latex>(&matrix::do_print_latex).
+  print_func<print_tree>(&matrix::do_print_tree).
+  print_func<print_python_repr>(&matrix::do_print_python_repr))
+
 //////////
-// default constructor, destructor, copy constructor, assignment operator
-// and helpers:
+// default constructor
 //////////
 
-// public
-
 /** Default ctor.  Initializes to 1 x 1-dimensional zero-matrix. */
-matrix::matrix()
-    : basic(TINFO_matrix), row(1), col(1)
+matrix::matrix() : inherited(&matrix::tinfo_static), row(1), col(1), m(1, _ex0)
 {
-    debugmsg("matrix default constructor",LOGLEVEL_CONSTRUCT);
-    m.push_back(exZERO());
+       setflag(status_flags::not_shareable);
 }
 
-matrix::~matrix()
+//////////
+// other constructors
+//////////
+
+// public
+
+/** Very common ctor.  Initializes to r x c-dimensional zero-matrix.
+ *
+ *  @param r number of rows
+ *  @param c number of cols */
+matrix::matrix(unsigned r, unsigned c)
+  : inherited(&matrix::tinfo_static), row(r), col(c), m(r*c, _ex0)
 {
-    debugmsg("matrix destructor",LOGLEVEL_DESTRUCT);
+       setflag(status_flags::not_shareable);
 }
 
-matrix::matrix(matrix const & other)
+// protected
+
+/** Ctor from representation, for internal use only. */
+matrix::matrix(unsigned r, unsigned c, const exvector & m2)
+  : inherited(&matrix::tinfo_static), row(r), col(c), m(m2)
 {
-    debugmsg("matrix copy constructor",LOGLEVEL_CONSTRUCT);
-    copy(other);
+       setflag(status_flags::not_shareable);
 }
 
-matrix const & matrix::operator=(matrix const & other)
+/** Construct matrix from (flat) list of elements. If the list has fewer
+ *  elements than the matrix, the remaining matrix elements are set to zero.
+ *  If the list has more elements than the matrix, the excessive elements are
+ *  thrown away. */
+matrix::matrix(unsigned r, unsigned c, const lst & l)
+  : inherited(&matrix::tinfo_static), row(r), col(c), m(r*c, _ex0)
 {
-    debugmsg("matrix operator=",LOGLEVEL_ASSIGNMENT);
-    if (this != &other) {
-        destroy(1);
-        copy(other);
-    }
-    return *this;
+       setflag(status_flags::not_shareable);
+
+       size_t i = 0;
+       for (lst::const_iterator it = l.begin(); it != l.end(); ++it, ++i) {
+               size_t x = i % c;
+               size_t y = i / c;
+               if (y >= r)
+                       break; // matrix smaller than list: throw away excessive elements
+               m[y*c+x] = *it;
+       }
 }
 
-// protected
+//////////
+// archiving
+//////////
 
-void matrix::copy(matrix const & other)
+matrix::matrix(const archive_node &n, lst &sym_lst) : inherited(n, sym_lst)
 {
-    basic::copy(other);
-    row=other.row;
-    col=other.col;
-    m=other.m;  // use STL's vector copying
+       setflag(status_flags::not_shareable);
+
+       if (!(n.find_unsigned("row", row)) || !(n.find_unsigned("col", col)))
+               throw (std::runtime_error("unknown matrix dimensions in archive"));
+       m.reserve(row * col);
+       for (unsigned int i=0; true; i++) {
+               ex e;
+               if (n.find_ex("m", e, sym_lst, i))
+                       m.push_back(e);
+               else
+                       break;
+       }
 }
 
-void matrix::destroy(bool call_parent)
+void matrix::archive(archive_node &n) const
 {
-    if (call_parent) basic::destroy(call_parent);
+       inherited::archive(n);
+       n.add_unsigned("row", row);
+       n.add_unsigned("col", col);
+       exvector::const_iterator i = m.begin(), iend = m.end();
+       while (i != iend) {
+               n.add_ex("m", *i);
+               ++i;
+       }
 }
 
+DEFAULT_UNARCHIVE(matrix)
+
 //////////
-// other constructors
+// functions overriding virtual functions from base classes
 //////////
 
 // public
 
-/** Very common ctor.  Initializes to r x c-dimensional zero-matrix.
- *
- *  @param r number of rows
- *  @param c number of cols */
-matrix::matrix(int r, int c)
-    : basic(TINFO_matrix), row(r), col(c)
+void matrix::print_elements(const print_context & c, const char *row_start, const char *row_end, const char *row_sep, const char *col_sep) const
 {
-    debugmsg("matrix constructor from int,int",LOGLEVEL_CONSTRUCT);
-    m.resize(r*c, exZERO());
+       for (unsigned ro=0; ro<row; ++ro) {
+               c.s << row_start;
+               for (unsigned co=0; co<col; ++co) {
+                       m[ro*col+co].print(c);
+                       if (co < col-1)
+                               c.s << col_sep;
+                       else
+                               c.s << row_end;
+               }
+               if (ro < row-1)
+                       c.s << row_sep;
+       }
 }
 
-// protected
-
-/** Ctor from representation, for internal use only. */
-matrix::matrix(int r, int c, vector<ex> const & m2)
-    : basic(TINFO_matrix), row(r), col(c), m(m2)
+void matrix::do_print(const print_context & c, unsigned level) const
 {
-    debugmsg("matrix constructor from int,int,vector<ex>",LOGLEVEL_CONSTRUCT);
+       c.s << "[";
+       print_elements(c, "[", "]", ",", ",");
+       c.s << "]";
 }
 
-//////////
-// functions overriding virtual functions from bases classes
-//////////
-
-// public
+void matrix::do_print_latex(const print_latex & c, unsigned level) const
+{
+       c.s << "\\left(\\begin{array}{" << std::string(col,'c') << "}";
+       print_elements(c, "", "", "\\\\", "&");
+       c.s << "\\end{array}\\right)";
+}
 
-basic * matrix::duplicate() const
+void matrix::do_print_python_repr(const print_python_repr & c, unsigned level) const
 {
-    debugmsg("matrix duplicate",LOGLEVEL_DUPLICATE);
-    return new matrix(*this);
+       c.s << class_name() << '(';
+       print_elements(c, "[", "]", ",", ",");
+       c.s << ')';
 }
 
 /** nops is defined to be rows x columns. */
-int matrix::nops() const
+size_t matrix::nops() const
 {
-    return row*col;
+       return static_cast<size_t>(row) * static_cast<size_t>(col);
 }
 
 /** returns matrix entry at position (i/col, i%col). */
-ex & matrix::let_op(int const i)
+ex matrix::op(size_t i) const
 {
-    return m[i];
+       GINAC_ASSERT(i<nops());
+       
+       return m[i];
 }
 
-/** expands the elements of a matrix entry by entry. */
-ex matrix::expand(unsigned options) const
+/** returns writable matrix entry at position (i/col, i%col). */
+ex & matrix::let_op(size_t i)
 {
-    vector<ex> tmp(row*col);
-    for (int i=0; i<row*col; ++i) {
-        tmp[i]=m[i].expand(options);
-    }
-    return matrix(row, col, tmp);
+       GINAC_ASSERT(i<nops());
+       
+       ensure_if_modifiable();
+       return m[i];
 }
 
-/** Search ocurrences.  A matrix 'has' an expression if it is the expression
- *  itself or one of the elements 'has' it. */
-bool matrix::has(ex const & other) const
+/** Evaluate matrix entry by entry. */
+ex matrix::eval(int level) const
 {
-    GINAC_ASSERT(other.bp!=0);
-    
-    // tautology: it is the expression itself
-    if (is_equal(*other.bp)) return true;
-    
-    // search all the elements
-    for (vector<ex>::const_iterator r=m.begin(); r!=m.end(); ++r) {
-        if ((*r).has(other)) return true;
-    }
-    return false;
+       // check if we have to do anything at all
+       if ((level==1)&&(flags & status_flags::evaluated))
+               return *this;
+       
+       // emergency break
+       if (level == -max_recursion_level)
+               throw (std::runtime_error("matrix::eval(): recursion limit exceeded"));
+       
+       // eval() entry by entry
+       exvector m2(row*col);
+       --level;
+       for (unsigned r=0; r<row; ++r)
+               for (unsigned c=0; c<col; ++c)
+                       m2[r*col+c] = m[r*col+c].eval(level);
+       
+       return (new matrix(row, col, m2))->setflag(status_flags::dynallocated |
+                                                                                          status_flags::evaluated);
 }
 
-/** evaluate matrix entry by entry. */
-ex matrix::eval(int level) const
+ex matrix::subs(const exmap & mp, unsigned options) const
+{
+       exvector m2(row * col);
+       for (unsigned r=0; r<row; ++r)
+               for (unsigned c=0; c<col; ++c)
+                       m2[r*col+c] = m[r*col+c].subs(mp, options);
+
+       return matrix(row, col, m2).subs_one_level(mp, options);
+}
+
+/** Complex conjugate every matrix entry. */
+ex matrix::conjugate() const
 {
-    debugmsg("matrix eval",LOGLEVEL_MEMBER_FUNCTION);
-    
-    // check if we have to do anything at all
-    if ((level==1)&&(flags & status_flags::evaluated)) {
-        return *this;
-    }
-    
-    // emergency break
-    if (level == -max_recursion_level) {
-        throw (std::runtime_error("matrix::eval(): recursion limit exceeded"));
-    }
-    
-    // eval() entry by entry
-    vector<ex> m2(row*col);
-    --level;    
-    for (int r=0; r<row; ++r) {
-        for (int c=0; c<col; ++c) {
-            m2[r*col+c] = m[r*col+c].eval(level);
-        }
-    }
-    
-    return (new matrix(row, col, m2))->setflag(status_flags::dynallocated |
-                                               status_flags::evaluated );
-}
-
-/** evaluate matrix numerically entry by entry. */
-ex matrix::evalf(int level) const
-{
-    debugmsg("matrix evalf",LOGLEVEL_MEMBER_FUNCTION);
-        
-    // check if we have to do anything at all
-    if (level==1) {
-        return *this;
-    }
-    
-    // emergency break
-    if (level == -max_recursion_level) {
-        throw (std::runtime_error("matrix::evalf(): recursion limit exceeded"));
-    }
-    
-    // evalf() entry by entry
-    vector<ex> m2(row*col);
-    --level;
-    for (int r=0; r<row; ++r) {
-        for (int c=0; c<col; ++c) {
-            m2[r*col+c] = m[r*col+c].evalf(level);
-        }
-    }
-    return matrix(row, col, m2);
+       exvector * ev = 0;
+       for (exvector::const_iterator i=m.begin(); i!=m.end(); ++i) {
+               ex x = i->conjugate();
+               if (ev) {
+                       ev->push_back(x);
+                       continue;
+               }
+               if (are_ex_trivially_equal(x, *i)) {
+                       continue;
+               }
+               ev = new exvector;
+               ev->reserve(m.size());
+               for (exvector::const_iterator j=m.begin(); j!=i; ++j) {
+                       ev->push_back(*j);
+               }
+               ev->push_back(x);
+       }
+       if (ev) {
+               ex result = matrix(row, col, *ev);
+               delete ev;
+               return result;
+       }
+       return *this;
 }
 
 // protected
 
-int matrix::compare_same_type(basic const & other) const
-{
-    GINAC_ASSERT(is_exactly_of_type(other, matrix));
-    matrix const & o=static_cast<matrix &>(const_cast<basic &>(other));
-    
-    // compare number of rows
-    if (row != o.rows()) {
-        return row < o.rows() ? -1 : 1;
-    }
-    
-    // compare number of columns
-    if (col != o.cols()) {
-        return col < o.cols() ? -1 : 1;
-    }
-    
-    // equal number of rows and columns, compare individual elements
-    int cmpval;
-    for (int r=0; r<row; ++r) {
-        for (int c=0; c<col; ++c) {
-            cmpval=((*this)(r,c)).compare(o(r,c));
-            if (cmpval!=0) return cmpval;
-        }
-    }
-    // all elements are equal => matrices are equal;
-    return 0;
+int matrix::compare_same_type(const basic & other) const
+{
+       GINAC_ASSERT(is_exactly_a<matrix>(other));
+       const matrix &o = static_cast<const matrix &>(other);
+       
+       // compare number of rows
+       if (row != o.rows())
+               return row < o.rows() ? -1 : 1;
+       
+       // compare number of columns
+       if (col != o.cols())
+               return col < o.cols() ? -1 : 1;
+       
+       // equal number of rows and columns, compare individual elements
+       int cmpval;
+       for (unsigned r=0; r<row; ++r) {
+               for (unsigned c=0; c<col; ++c) {
+                       cmpval = ((*this)(r,c)).compare(o(r,c));
+                       if (cmpval!=0) return cmpval;
+               }
+       }
+       // all elements are equal => matrices are equal;
+       return 0;
 }
 
+bool matrix::match_same_type(const basic & other) const
+{
+       GINAC_ASSERT(is_exactly_a<matrix>(other));
+       const matrix & o = static_cast<const matrix &>(other);
+       
+       // The number of rows and columns must be the same. This is necessary to
+       // prevent a 2x3 matrix from matching a 3x2 one.
+       return row == o.rows() && col == o.cols();
+}
+
+/** Automatic symbolic evaluation of an indexed matrix. */
+ex matrix::eval_indexed(const basic & i) const
+{
+       GINAC_ASSERT(is_a<indexed>(i));
+       GINAC_ASSERT(is_a<matrix>(i.op(0)));
+
+       bool all_indices_unsigned = static_cast<const indexed &>(i).all_index_values_are(info_flags::nonnegint);
+
+       // Check indices
+       if (i.nops() == 2) {
+
+               // One index, must be one-dimensional vector
+               if (row != 1 && col != 1)
+                       throw (std::runtime_error("matrix::eval_indexed(): vector must have exactly 1 index"));
+
+               const idx & i1 = ex_to<idx>(i.op(1));
+
+               if (col == 1) {
+
+                       // Column vector
+                       if (!i1.get_dim().is_equal(row))
+                               throw (std::runtime_error("matrix::eval_indexed(): dimension of index must match number of vector elements"));
+
+                       // Index numeric -> return vector element
+                       if (all_indices_unsigned) {
+                               unsigned n1 = ex_to<numeric>(i1.get_value()).to_int();
+                               if (n1 >= row)
+                                       throw (std::runtime_error("matrix::eval_indexed(): value of index exceeds number of vector elements"));
+                               return (*this)(n1, 0);
+                       }
+
+               } else {
+
+                       // Row vector
+                       if (!i1.get_dim().is_equal(col))
+                               throw (std::runtime_error("matrix::eval_indexed(): dimension of index must match number of vector elements"));
+
+                       // Index numeric -> return vector element
+                       if (all_indices_unsigned) {
+                               unsigned n1 = ex_to<numeric>(i1.get_value()).to_int();
+                               if (n1 >= col)
+                                       throw (std::runtime_error("matrix::eval_indexed(): value of index exceeds number of vector elements"));
+                               return (*this)(0, n1);
+                       }
+               }
+
+       } else if (i.nops() == 3) {
+
+               // Two indices
+               const idx & i1 = ex_to<idx>(i.op(1));
+               const idx & i2 = ex_to<idx>(i.op(2));
+
+               if (!i1.get_dim().is_equal(row))
+                       throw (std::runtime_error("matrix::eval_indexed(): dimension of first index must match number of rows"));
+               if (!i2.get_dim().is_equal(col))
+                       throw (std::runtime_error("matrix::eval_indexed(): dimension of second index must match number of columns"));
+
+               // Pair of dummy indices -> compute trace
+               if (is_dummy_pair(i1, i2))
+                       return trace();
+
+               // Both indices numeric -> return matrix element
+               if (all_indices_unsigned) {
+                       unsigned n1 = ex_to<numeric>(i1.get_value()).to_int(), n2 = ex_to<numeric>(i2.get_value()).to_int();
+                       if (n1 >= row)
+                               throw (std::runtime_error("matrix::eval_indexed(): value of first index exceeds number of rows"));
+                       if (n2 >= col)
+                               throw (std::runtime_error("matrix::eval_indexed(): value of second index exceeds number of columns"));
+                       return (*this)(n1, n2);
+               }
+
+       } else
+               throw (std::runtime_error("matrix::eval_indexed(): matrix must have exactly 2 indices"));
+
+       return i.hold();
+}
+
+/** Sum of two indexed matrices. */
+ex matrix::add_indexed(const ex & self, const ex & other) const
+{
+       GINAC_ASSERT(is_a<indexed>(self));
+       GINAC_ASSERT(is_a<matrix>(self.op(0)));
+       GINAC_ASSERT(is_a<indexed>(other));
+       GINAC_ASSERT(self.nops() == 2 || self.nops() == 3);
+
+       // Only add two matrices
+       if (is_a<matrix>(other.op(0))) {
+               GINAC_ASSERT(other.nops() == 2 || other.nops() == 3);
+
+               const matrix &self_matrix = ex_to<matrix>(self.op(0));
+               const matrix &other_matrix = ex_to<matrix>(other.op(0));
+
+               if (self.nops() == 2 && other.nops() == 2) { // vector + vector
+
+                       if (self_matrix.row == other_matrix.row)
+                               return indexed(self_matrix.add(other_matrix), self.op(1));
+                       else if (self_matrix.row == other_matrix.col)
+                               return indexed(self_matrix.add(other_matrix.transpose()), self.op(1));
+
+               } else if (self.nops() == 3 && other.nops() == 3) { // matrix + matrix
+
+                       if (self.op(1).is_equal(other.op(1)) && self.op(2).is_equal(other.op(2)))
+                               return indexed(self_matrix.add(other_matrix), self.op(1), self.op(2));
+                       else if (self.op(1).is_equal(other.op(2)) && self.op(2).is_equal(other.op(1)))
+                               return indexed(self_matrix.add(other_matrix.transpose()), self.op(1), self.op(2));
+
+               }
+       }
+
+       // Don't know what to do, return unevaluated sum
+       return self + other;
+}
+
+/** Product of an indexed matrix with a number. */
+ex matrix::scalar_mul_indexed(const ex & self, const numeric & other) const
+{
+       GINAC_ASSERT(is_a<indexed>(self));
+       GINAC_ASSERT(is_a<matrix>(self.op(0)));
+       GINAC_ASSERT(self.nops() == 2 || self.nops() == 3);
+
+       const matrix &self_matrix = ex_to<matrix>(self.op(0));
+
+       if (self.nops() == 2)
+               return indexed(self_matrix.mul(other), self.op(1));
+       else // self.nops() == 3
+               return indexed(self_matrix.mul(other), self.op(1), self.op(2));
+}
+
+/** Contraction of an indexed matrix with something else. */
+bool matrix::contract_with(exvector::iterator self, exvector::iterator other, exvector & v) const
+{
+       GINAC_ASSERT(is_a<indexed>(*self));
+       GINAC_ASSERT(is_a<indexed>(*other));
+       GINAC_ASSERT(self->nops() == 2 || self->nops() == 3);
+       GINAC_ASSERT(is_a<matrix>(self->op(0)));
+
+       // Only contract with other matrices
+       if (!is_a<matrix>(other->op(0)))
+               return false;
+
+       GINAC_ASSERT(other->nops() == 2 || other->nops() == 3);
+
+       const matrix &self_matrix = ex_to<matrix>(self->op(0));
+       const matrix &other_matrix = ex_to<matrix>(other->op(0));
+
+       if (self->nops() == 2) {
+
+               if (other->nops() == 2) { // vector * vector (scalar product)
+
+                       if (self_matrix.col == 1) {
+                               if (other_matrix.col == 1) {
+                                       // Column vector * column vector, transpose first vector
+                                       *self = self_matrix.transpose().mul(other_matrix)(0, 0);
+                               } else {
+                                       // Column vector * row vector, swap factors
+                                       *self = other_matrix.mul(self_matrix)(0, 0);
+                               }
+                       } else {
+                               if (other_matrix.col == 1) {
+                                       // Row vector * column vector, perfect
+                                       *self = self_matrix.mul(other_matrix)(0, 0);
+                               } else {
+                                       // Row vector * row vector, transpose second vector
+                                       *self = self_matrix.mul(other_matrix.transpose())(0, 0);
+                               }
+                       }
+                       *other = _ex1;
+                       return true;
+
+               } else { // vector * matrix
+
+                       // B_i * A_ij = (B*A)_j (B is row vector)
+                       if (is_dummy_pair(self->op(1), other->op(1))) {
+                               if (self_matrix.row == 1)
+                                       *self = indexed(self_matrix.mul(other_matrix), other->op(2));
+                               else
+                                       *self = indexed(self_matrix.transpose().mul(other_matrix), other->op(2));
+                               *other = _ex1;
+                               return true;
+                       }
+
+                       // B_j * A_ij = (A*B)_i (B is column vector)
+                       if (is_dummy_pair(self->op(1), other->op(2))) {
+                               if (self_matrix.col == 1)
+                                       *self = indexed(other_matrix.mul(self_matrix), other->op(1));
+                               else
+                                       *self = indexed(other_matrix.mul(self_matrix.transpose()), other->op(1));
+                               *other = _ex1;
+                               return true;
+                       }
+               }
+
+       } else if (other->nops() == 3) { // matrix * matrix
+
+               // A_ij * B_jk = (A*B)_ik
+               if (is_dummy_pair(self->op(2), other->op(1))) {
+                       *self = indexed(self_matrix.mul(other_matrix), self->op(1), other->op(2));
+                       *other = _ex1;
+                       return true;
+               }
+
+               // A_ij * B_kj = (A*Btrans)_ik
+               if (is_dummy_pair(self->op(2), other->op(2))) {
+                       *self = indexed(self_matrix.mul(other_matrix.transpose()), self->op(1), other->op(1));
+                       *other = _ex1;
+                       return true;
+               }
+
+               // A_ji * B_jk = (Atrans*B)_ik
+               if (is_dummy_pair(self->op(1), other->op(1))) {
+                       *self = indexed(self_matrix.transpose().mul(other_matrix), self->op(2), other->op(2));
+                       *other = _ex1;
+                       return true;
+               }
+
+               // A_ji * B_kj = (B*A)_ki
+               if (is_dummy_pair(self->op(1), other->op(2))) {
+                       *self = indexed(other_matrix.mul(self_matrix), other->op(1), self->op(2));
+                       *other = _ex1;
+                       return true;
+               }
+       }
+
+       return false;
+}
+
+
 //////////
 // non-virtual functions in this class
 //////////
@@ -247,629 +537,1116 @@ int matrix::compare_same_type(basic const & other) const
 /** Sum of matrices.
  *
  *  @exception logic_error (incompatible matrices) */
-matrix matrix::add(matrix const & other) const
-{
-    if (col != other.col || row != other.row) {
-        throw (std::logic_error("matrix::add(): incompatible matrices"));
-    }
-    
-    vector<ex> sum(this->m);
-    vector<ex>::iterator i;
-    vector<ex>::const_iterator ci;
-    for (i=sum.begin(), ci=other.m.begin();
-         i!=sum.end();
-         ++i, ++ci) {
-        (*i) += (*ci);
-    }
-    return matrix(row,col,sum);
+matrix matrix::add(const matrix & other) const
+{
+       if (col != other.col || row != other.row)
+               throw std::logic_error("matrix::add(): incompatible matrices");
+       
+       exvector sum(this->m);
+       exvector::iterator i = sum.begin(), end = sum.end();
+       exvector::const_iterator ci = other.m.begin();
+       while (i != end)
+               *i++ += *ci++;
+       
+       return matrix(row,col,sum);
 }
 
+
 /** Difference of matrices.
  *
  *  @exception logic_error (incompatible matrices) */
-matrix matrix::sub(matrix const & other) const
-{
-    if (col != other.col || row != other.row) {
-        throw (std::logic_error("matrix::sub(): incompatible matrices"));
-    }
-    
-    vector<ex> dif(this->m);
-    vector<ex>::iterator i;
-    vector<ex>::const_iterator ci;
-    for (i=dif.begin(), ci=other.m.begin();
-         i!=dif.end();
-         ++i, ++ci) {
-        (*i) -= (*ci);
-    }
-    return matrix(row,col,dif);
+matrix matrix::sub(const matrix & other) const
+{
+       if (col != other.col || row != other.row)
+               throw std::logic_error("matrix::sub(): incompatible matrices");
+       
+       exvector dif(this->m);
+       exvector::iterator i = dif.begin(), end = dif.end();
+       exvector::const_iterator ci = other.m.begin();
+       while (i != end)
+               *i++ -= *ci++;
+       
+       return matrix(row,col,dif);
 }
 
+
 /** Product of matrices.
  *
  *  @exception logic_error (incompatible matrices) */
-matrix matrix::mul(matrix const & other) const
-{
-    if (col != other.row) {
-        throw (std::logic_error("matrix::mul(): incompatible matrices"));
-    }
-    
-    vector<ex> prod(row*other.col);
-    for (int i=0; i<row; ++i) {
-        for (int j=0; j<other.col; ++j) {
-            for (int l=0; l<col; ++l) {
-                prod[i*other.col+j] += m[i*col+l] * other.m[l*other.col+j];
-            }
-        }
-    }
-    return matrix(row, other.col, prod);
-}
-
-/** operator() to access elements.
+matrix matrix::mul(const matrix & other) const
+{
+       if (this->cols() != other.rows())
+               throw std::logic_error("matrix::mul(): incompatible matrices");
+       
+       exvector prod(this->rows()*other.cols());
+       
+       for (unsigned r1=0; r1<this->rows(); ++r1) {
+               for (unsigned c=0; c<this->cols(); ++c) {
+                       // Quick test: can we shortcut?
+                       if (m[r1*col+c].is_zero())
+                               continue;
+                       for (unsigned r2=0; r2<other.cols(); ++r2)
+                               prod[r1*other.col+r2] += (m[r1*col+c] * other.m[c*other.col+r2]);
+               }
+       }
+       return matrix(row, other.col, prod);
+}
+
+
+/** Product of matrix and scalar. */
+matrix matrix::mul(const numeric & other) const
+{
+       exvector prod(row * col);
+
+       for (unsigned r=0; r<row; ++r)
+               for (unsigned c=0; c<col; ++c)
+                       prod[r*col+c] = m[r*col+c] * other;
+
+       return matrix(row, col, prod);
+}
+
+
+/** Product of matrix and scalar expression. */
+matrix matrix::mul_scalar(const ex & other) const
+{
+       if (other.return_type() != return_types::commutative)
+               throw std::runtime_error("matrix::mul_scalar(): non-commutative scalar");
+
+       exvector prod(row * col);
+
+       for (unsigned r=0; r<row; ++r)
+               for (unsigned c=0; c<col; ++c)
+                       prod[r*col+c] = m[r*col+c] * other;
+
+       return matrix(row, col, prod);
+}
+
+
+/** Power of a matrix.  Currently handles integer exponents only. */
+matrix matrix::pow(const ex & expn) const
+{
+       if (col!=row)
+               throw (std::logic_error("matrix::pow(): matrix not square"));
+       
+       if (is_exactly_a<numeric>(expn)) {
+               // Integer cases are computed by successive multiplication, using the
+               // obvious shortcut of storing temporaries, like A^4 == (A*A)*(A*A).
+               if (expn.info(info_flags::integer)) {
+                       numeric b = ex_to<numeric>(expn);
+                       matrix A(row,col);
+                       if (expn.info(info_flags::negative)) {
+                               b *= -1;
+                               A = this->inverse();
+                       } else {
+                               A = *this;
+                       }
+                       matrix C(row,col);
+                       for (unsigned r=0; r<row; ++r)
+                               C(r,r) = _ex1;
+                       if (b.is_zero())
+                               return C;
+                       // This loop computes the representation of b in base 2 from right
+                       // to left and multiplies the factors whenever needed.  Note
+                       // that this is not entirely optimal but close to optimal and
+                       // "better" algorithms are much harder to implement.  (See Knuth,
+                       // TAoCP2, section "Evaluation of Powers" for a good discussion.)
+                       while (b!=*_num1_p) {
+                               if (b.is_odd()) {
+                                       C = C.mul(A);
+                                       --b;
+                               }
+                               b /= *_num2_p;  // still integer.
+                               A = A.mul(A);
+                       }
+                       return A.mul(C);
+               }
+       }
+       throw (std::runtime_error("matrix::pow(): don't know how to handle exponent"));
+}
+
+
+/** operator() to access elements for reading.
  *
  *  @param ro row of element
- *  @param co column of element 
+ *  @param co column of element
  *  @exception range_error (index out of range) */
-ex const & matrix::operator() (int ro, int co) const
+const ex & matrix::operator() (unsigned ro, unsigned co) const
 {
-    if (ro<0 || ro>=row || co<0 || co>=col) {
-        throw (std::range_error("matrix::operator(): index out of range"));
-    }
-    
-    return m[ro*col+co];
+       if (ro>=row || co>=col)
+               throw (std::range_error("matrix::operator(): index out of range"));
+
+       return m[ro*col+co];
 }
 
-/** Set individual elements manually.
+
+/** operator() to access elements for writing.
  *
+ *  @param ro row of element
+ *  @param co column of element
  *  @exception range_error (index out of range) */
-matrix & matrix::set(int ro, int co, ex value)
+ex & matrix::operator() (unsigned ro, unsigned co)
 {
-    if (ro<0 || ro>=row || co<0 || co>=col) {
-        throw (std::range_error("matrix::set(): index out of range"));
-    }
-    
-    ensure_if_modifiable();
-    m[ro*col+co]=value;
-    return *this;
+       if (ro>=row || co>=col)
+               throw (std::range_error("matrix::operator(): index out of range"));
+
+       ensure_if_modifiable();
+       return m[ro*col+co];
 }
 
+
 /** Transposed of an m x n matrix, producing a new n x m matrix object that
  *  represents the transposed. */
-matrix matrix::transpose(void) const
-{
-    vector<ex> trans(col*row);
-    
-    for (int r=0; r<col; ++r) {
-        for (int c=0; c<row; ++c) {
-            trans[r*row+c] = m[c*col+r];
-        }
-    }
-    return matrix(col,row,trans);
-}
-
-/* Determiant of purely numeric matrix, using pivoting. This routine is only
- * called internally by matrix::determinant(). */
-ex determinant_numeric(const matrix & M)
-{
-    GINAC_ASSERT(M.rows()==M.cols());  // cannot happen, just in case...
-    matrix tmp(M);
-    ex det=exONE();
-    ex piv;
-    
-    for (int r1=0; r1<M.rows(); ++r1) {
-        int indx = tmp.pivot(r1);
-        if (indx == -1) {
-            return exZERO();
-        }
-        if (indx != 0) {
-            det *= exMINUSONE();
-        }
-        det = det * tmp.m[r1*M.cols()+r1];
-        for (int r2=r1+1; r2<M.rows(); ++r2) {
-            piv = tmp.m[r2*M.cols()+r1] / tmp.m[r1*M.cols()+r1];
-            for (int c=r1+1; c<M.cols(); c++) {
-                tmp.m[r2*M.cols()+c] -= piv * tmp.m[r1*M.cols()+c];
-            }
-        }
-    }
-    return det;
-}
-
-// Compute the sign of a permutation of a vector of things, used internally
-// by determinant_symbolic_perm() where it is instantiated for int.
-template <class T>
-int permutation_sign(vector<T> s)
-{
-    if (s.size() < 2)
-        return 0;
-    int sigma=1;
-    for (typename vector<T>::iterator i=s.begin(); i!=s.end()-1; ++i) {
-        for (typename vector<T>::iterator j=i+1; j!=s.end(); ++j) {
-            if (*i == *j)
-                return 0;
-            if (*i > *j) {
-                iter_swap(i,j);
-                sigma = -sigma;
-            }
-        }
-    }
-    return sigma;
-}
-
-/** Determinant built by application of the full permutation group. This
- *  routine is only called internally by matrix::determinant(). */
-ex determinant_symbolic_perm(const matrix & M)
-{
-    GINAC_ASSERT(M.rows()==M.cols());  // cannot happen, just in case...
-    
-    if (M.rows()==1) {  // speed things up
-        return M(0,0);
-    }
-    
-    ex det;
-    ex term;
-    vector<int> sigma(M.cols());
-    for (int i=0; i<M.cols(); ++i) sigma[i]=i;
-    
-    do {
-        term = M(sigma[0],0);
-        for (int i=1; i<M.cols(); ++i) term *= M(sigma[i],i);
-        det += permutation_sign(sigma)*term;
-    } while (next_permutation(sigma.begin(), sigma.end()));
-    
-    return det;
-}
-
-/** Recursive determiant for small matrices having at least one symbolic entry.
- *  This algorithm is also known as Laplace-expansion. This routine is only
- *  called internally by matrix::determinant(). */
-ex determinant_symbolic_minor(const matrix & M)
-{
-    GINAC_ASSERT(M.rows()==M.cols());  // cannot happen, just in case...
-    
-    if (M.rows()==1) {  // end of recursion
-        return M(0,0);
-    }
-    if (M.rows()==2) {  // speed things up
-        return (M(0,0)*M(1,1)-
-                M(1,0)*M(0,1));
-    }
-    if (M.rows()==3) {  // speed things up even a little more
-        return ((M(2,1)*M(0,2)-M(2,2)*M(0,1))*M(1,0)+
-                (M(1,2)*M(0,1)-M(1,1)*M(0,2))*M(2,0)+
-                (M(2,2)*M(1,1)-M(2,1)*M(1,2))*M(0,0));
-    }
-    
-    ex det;
-    matrix minorM(M.rows()-1,M.cols()-1);
-    for (int r1=0; r1<M.rows(); ++r1) {
-        // assemble the minor matrix
-        for (int r=0; r<minorM.rows(); ++r) {
-            for (int c=0; c<minorM.cols(); ++c) {
-                if (r<r1) {
-                    minorM.set(r,c,M(r,c+1));
-                } else {
-                    minorM.set(r,c,M(r+1,c+1));
-                }
-            }
-        }
-        // recurse down
-        if (r1%2) {
-            det -= M(r1,0) * determinant_symbolic_minor(minorM);
-        } else {
-            det += M(r1,0) * determinant_symbolic_minor(minorM);
-        }
-    }
-    return det;
-}
-
-/*  Leverrier algorithm for large matrices having at least one symbolic entry.
- *  This routine is only called internally by matrix::determinant(). The
- *  algorithm is deemed bad for symbolic matrices since it returns expressions
- *  that are very hard to canonicalize. */
-/*ex determinant_symbolic_leverrier(const matrix & M)
- *{
- *    GINAC_ASSERT(M.rows()==M.cols());  // cannot happen, just in case...
- *    
- *    matrix B(M);
- *    matrix I(M.row, M.col);
- *    ex c=B.trace();
- *    for (int i=1; i<M.row; ++i) {
- *        for (int j=0; j<M.row; ++j)
- *            I.m[j*M.col+j] = c;
- *        B = M.mul(B.sub(I));
- *        c = B.trace()/ex(i+1);
- *    }
- *    if (M.row%2) {
- *        return c;
- *    } else {
- *        return -c;
- *    }
- *}*/
+matrix matrix::transpose() const
+{
+       exvector trans(this->cols()*this->rows());
+       
+       for (unsigned r=0; r<this->cols(); ++r)
+               for (unsigned c=0; c<this->rows(); ++c)
+                       trans[r*this->rows()+c] = m[c*this->cols()+r];
+       
+       return matrix(this->cols(),this->rows(),trans);
+}
 
 /** Determinant of square matrix.  This routine doesn't actually calculate the
  *  determinant, it only implements some heuristics about which algorithm to
- *  call.  When the parameter for normalization is explicitly turned off this
- *  method does not normalize its result at the end, which might imply that
- *  the symbolic 2x2 matrix [[a/(a-b),1],[b/(a-b),1]] is not immediatly
- *  recognized to be unity.  (This is Mathematica's default behaviour, it
- *  should be used with care.)
+ *  run.  If all the elements of the matrix are elements of an integral domain
+ *  the determinant is also in that integral domain and the result is expanded
+ *  only.  If one or more elements are from a quotient field the determinant is
+ *  usually also in that quotient field and the result is normalized before it
+ *  is returned.  This implies that the determinant of the symbolic 2x2 matrix
+ *  [[a/(a-b),1],[b/(a-b),1]] is returned as unity.  (In this respect, it
+ *  behaves like MapleV and unlike Mathematica.)
  *
- *  @param     normalized may be set to false if no normalization of the
- *             result is desired (i.e. to force Mathematica behavior, Maple
- *             does normalize the result).
+ *  @param     algo allows to chose an algorithm
  *  @return    the determinant as a new expression
- *  @exception logic_error (matrix not square) */
-ex matrix::determinant(bool normalized) const
-{
-    if (row != col) {
-        throw (std::logic_error("matrix::determinant(): matrix not square"));
-    }
-
-    // check, if there are non-numeric entries in the matrix:
-    for (vector<ex>::const_iterator r=m.begin(); r!=m.end(); ++r) {
-        if (!(*r).info(info_flags::numeric)) {
-            if (normalized) {
-                return determinant_symbolic_minor(*this).normal();
-            } else {
-                return determinant_symbolic_perm(*this);
-            }
-        }
-    }
-    // if it turns out that all elements are numeric
-    return determinant_numeric(*this);
-}
-
-/** Trace of a matrix.
+ *  @exception logic_error (matrix not square)
+ *  @see       determinant_algo */
+ex matrix::determinant(unsigned algo) const
+{
+       if (row!=col)
+               throw (std::logic_error("matrix::determinant(): matrix not square"));
+       GINAC_ASSERT(row*col==m.capacity());
+       
+       // Gather some statistical information about this matrix:
+       bool numeric_flag = true;
+       bool normal_flag = false;
+       unsigned sparse_count = 0;  // counts non-zero elements
+       exvector::const_iterator r = m.begin(), rend = m.end();
+       while (r != rend) {
+               if (!r->info(info_flags::numeric))
+                       numeric_flag = false;
+               exmap srl;  // symbol replacement list
+               ex rtest = r->to_rational(srl);
+               if (!rtest.is_zero())
+                       ++sparse_count;
+               if (!rtest.info(info_flags::crational_polynomial) &&
+                        rtest.info(info_flags::rational_function))
+                       normal_flag = true;
+               ++r;
+       }
+       
+       // Here is the heuristics in case this routine has to decide:
+       if (algo == determinant_algo::automatic) {
+               // Minor expansion is generally a good guess:
+               algo = determinant_algo::laplace;
+               // Does anybody know when a matrix is really sparse?
+               // Maybe <~row/2.236 nonzero elements average in a row?
+               if (row>3 && 5*sparse_count<=row*col)
+                       algo = determinant_algo::bareiss;
+               // Purely numeric matrix can be handled by Gauss elimination.
+               // This overrides any prior decisions.
+               if (numeric_flag)
+                       algo = determinant_algo::gauss;
+       }
+       
+       // Trap the trivial case here, since some algorithms don't like it
+       if (this->row==1) {
+               // for consistency with non-trivial determinants...
+               if (normal_flag)
+                       return m[0].normal();
+               else
+                       return m[0].expand();
+       }
+
+       // Compute the determinant
+       switch(algo) {
+               case determinant_algo::gauss: {
+                       ex det = 1;
+                       matrix tmp(*this);
+                       int sign = tmp.gauss_elimination(true);
+                       for (unsigned d=0; d<row; ++d)
+                               det *= tmp.m[d*col+d];
+                       if (normal_flag)
+                               return (sign*det).normal();
+                       else
+                               return (sign*det).normal().expand();
+               }
+               case determinant_algo::bareiss: {
+                       matrix tmp(*this);
+                       int sign;
+                       sign = tmp.fraction_free_elimination(true);
+                       if (normal_flag)
+                               return (sign*tmp.m[row*col-1]).normal();
+                       else
+                               return (sign*tmp.m[row*col-1]).expand();
+               }
+               case determinant_algo::divfree: {
+                       matrix tmp(*this);
+                       int sign;
+                       sign = tmp.division_free_elimination(true);
+                       if (sign==0)
+                               return _ex0;
+                       ex det = tmp.m[row*col-1];
+                       // factor out accumulated bogus slag
+                       for (unsigned d=0; d<row-2; ++d)
+                               for (unsigned j=0; j<row-d-2; ++j)
+                                       det = (det/tmp.m[d*col+d]).normal();
+                       return (sign*det);
+               }
+               case determinant_algo::laplace:
+               default: {
+                       // This is the minor expansion scheme.  We always develop such
+                       // that the smallest minors (i.e, the trivial 1x1 ones) are on the
+                       // rightmost column.  For this to be efficient, empirical tests
+                       // have shown that the emptiest columns (i.e. the ones with most
+                       // zeros) should be the ones on the right hand side -- although
+                       // this might seem counter-intuitive (and in contradiction to some
+                       // literature like the FORM manual).  Please go ahead and test it
+                       // if you don't believe me!  Therefore we presort the columns of
+                       // the matrix:
+                       typedef std::pair<unsigned,unsigned> uintpair;
+                       std::vector<uintpair> c_zeros;  // number of zeros in column
+                       for (unsigned c=0; c<col; ++c) {
+                               unsigned acc = 0;
+                               for (unsigned r=0; r<row; ++r)
+                                       if (m[r*col+c].is_zero())
+                                               ++acc;
+                               c_zeros.push_back(uintpair(acc,c));
+                       }
+                       std::sort(c_zeros.begin(),c_zeros.end());
+                       std::vector<unsigned> pre_sort;
+                       for (std::vector<uintpair>::const_iterator i=c_zeros.begin(); i!=c_zeros.end(); ++i)
+                               pre_sort.push_back(i->second);
+                       std::vector<unsigned> pre_sort_test(pre_sort); // permutation_sign() modifies the vector so we make a copy here
+                       int sign = permutation_sign(pre_sort_test.begin(), pre_sort_test.end());
+                       exvector result(row*col);  // represents sorted matrix
+                       unsigned c = 0;
+                       for (std::vector<unsigned>::const_iterator i=pre_sort.begin();
+                                i!=pre_sort.end();
+                                ++i,++c) {
+                               for (unsigned r=0; r<row; ++r)
+                                       result[r*col+c] = m[r*col+(*i)];
+                       }
+                       
+                       if (normal_flag)
+                               return (sign*matrix(row,col,result).determinant_minor()).normal();
+                       else
+                               return sign*matrix(row,col,result).determinant_minor();
+               }
+       }
+}
+
+
+/** Trace of a matrix.  The result is normalized if it is in some quotient
+ *  field and expanded only otherwise.  This implies that the trace of the
+ *  symbolic 2x2 matrix [[a/(a-b),x],[y,b/(b-a)]] is recognized to be unity.
  *
  *  @return    the sum of diagonal elements
  *  @exception logic_error (matrix not square) */
-ex matrix::trace(void) const
-{
-    if (row != col) {
-        throw (std::logic_error("matrix::trace(): matrix not square"));
-    }
-    
-    ex tr;
-    for (int r=0; r<col; ++r) {
-        tr += m[r*col+r];
-    }
-    return tr;
-}
-
-/** Characteristic Polynomial.  The characteristic polynomial of a matrix M is
- *  defined as the determiant of (M - lambda * 1) where 1 stands for the unit
- *  matrix of the same dimension as M.  This method returns the characteristic
- *  polynomial as a new expression.
+ex matrix::trace() const
+{
+       if (row != col)
+               throw (std::logic_error("matrix::trace(): matrix not square"));
+       
+       ex tr;
+       for (unsigned r=0; r<col; ++r)
+               tr += m[r*col+r];
+       
+       if (tr.info(info_flags::rational_function) &&
+          !tr.info(info_flags::crational_polynomial))
+               return tr.normal();
+       else
+               return tr.expand();
+}
+
+
+/** Characteristic Polynomial.  Following mathematica notation the
+ *  characteristic polynomial of a matrix M is defined as the determiant of
+ *  (M - lambda * 1) where 1 stands for the unit matrix of the same dimension
+ *  as M.  Note that some CASs define it with a sign inside the determinant
+ *  which gives rise to an overall sign if the dimension is odd.  This method
+ *  returns the characteristic polynomial collected in powers of lambda as a
+ *  new expression.
  *
  *  @return    characteristic polynomial as new expression
  *  @exception logic_error (matrix not square)
  *  @see       matrix::determinant() */
-ex matrix::charpoly(ex const & lambda) const
+ex matrix::charpoly(const ex & lambda) const
 {
-    if (row != col) {
-        throw (std::logic_error("matrix::charpoly(): matrix not square"));
-    }
-    
-    matrix M(*this);
-    for (int r=0; r<col; ++r) {
-        M.m[r*col+r] -= lambda;
-    }
-    return (M.determinant());
+       if (row != col)
+               throw (std::logic_error("matrix::charpoly(): matrix not square"));
+       
+       bool numeric_flag = true;
+       exvector::const_iterator r = m.begin(), rend = m.end();
+       while (r!=rend && numeric_flag==true) {
+               if (!r->info(info_flags::numeric))
+                       numeric_flag = false;
+               ++r;
+       }
+       
+       // The pure numeric case is traditionally rather common.  Hence, it is
+       // trapped and we use Leverrier's algorithm which goes as row^3 for
+       // every coefficient.  The expensive part is the matrix multiplication.
+       if (numeric_flag) {
+
+               matrix B(*this);
+               ex c = B.trace();
+               ex poly = power(lambda, row) - c*power(lambda, row-1);
+               for (unsigned i=1; i<row; ++i) {
+                       for (unsigned j=0; j<row; ++j)
+                               B.m[j*col+j] -= c;
+                       B = this->mul(B);
+                       c = B.trace() / ex(i+1);
+                       poly -= c*power(lambda, row-i-1);
+               }
+               if (row%2)
+                       return -poly;
+               else
+                       return poly;
+
+       } else {
+       
+               matrix M(*this);
+               for (unsigned r=0; r<col; ++r)
+                       M.m[r*col+r] -= lambda;
+       
+               return M.determinant().collect(lambda);
+       }
 }
 
+
 /** Inverse of this matrix.
  *
  *  @return    the inverted matrix
  *  @exception logic_error (matrix not square)
  *  @exception runtime_error (singular matrix) */
-matrix matrix::inverse(void) const
-{
-    if (row != col) {
-        throw (std::logic_error("matrix::inverse(): matrix not square"));
-    }
-    
-    matrix tmp(row,col);
-    // set tmp to the unit matrix
-    for (int i=0; i<col; ++i) {
-        tmp.m[i*col+i] = exONE();
-    }
-    // create a copy of this matrix
-    matrix cpy(*this);
-    for (int r1=0; r1<row; ++r1) {
-        int indx = cpy.pivot(r1);
-        if (indx == -1) {
-            throw (std::runtime_error("matrix::inverse(): singular matrix"));
-        }
-        if (indx != 0) {  // swap rows r and indx of matrix tmp
-            for (int i=0; i<col; ++i) {
-                tmp.m[r1*col+i].swap(tmp.m[indx*col+i]);
-            }
-        }
-        ex a1 = cpy.m[r1*col+r1];
-        for (int c=0; c<col; ++c) {
-            cpy.m[r1*col+c] /= a1;
-            tmp.m[r1*col+c] /= a1;
-        }
-        for (int r2=0; r2<row; ++r2) {
-            if (r2 != r1) {
-                ex a2 = cpy.m[r2*col+r1];
-                for (int c=0; c<col; ++c) {
-                    cpy.m[r2*col+c] -= a2 * cpy.m[r1*col+c];
-                    tmp.m[r2*col+c] -= a2 * tmp.m[r1*col+c];
-                }
-            }
-        }
-    }
-    return tmp;
-}
-
-void matrix::ffe_swap(int r1, int c1, int r2 ,int c2)
-{
-    ensure_if_modifiable();
-    
-    ex tmp=ffe_get(r1,c1);
-    ffe_set(r1,c1,ffe_get(r2,c2));
-    ffe_set(r2,c2,tmp);
-}
-
-void matrix::ffe_set(int r, int c, ex e)
-{
-    set(r-1,c-1,e);
-}
-
-ex matrix::ffe_get(int r, int c) const
-{
-    return operator()(r-1,c-1);
-}
-
-/** Solve a set of equations for an m x n matrix by fraction-free Gaussian
- *  elimination. Based on algorithm 9.1 from 'Algorithms for Computer Algebra'
- *  by Keith O. Geddes et al.
+matrix matrix::inverse() const
+{
+       if (row != col)
+               throw (std::logic_error("matrix::inverse(): matrix not square"));
+       
+       // This routine actually doesn't do anything fancy at all.  We compute the
+       // inverse of the matrix A by solving the system A * A^{-1} == Id.
+       
+       // First populate the identity matrix supposed to become the right hand side.
+       matrix identity(row,col);
+       for (unsigned i=0; i<row; ++i)
+               identity(i,i) = _ex1;
+       
+       // Populate a dummy matrix of variables, just because of compatibility with
+       // matrix::solve() which wants this (for compatibility with under-determined
+       // systems of equations).
+       matrix vars(row,col);
+       for (unsigned r=0; r<row; ++r)
+               for (unsigned c=0; c<col; ++c)
+                       vars(r,c) = symbol();
+       
+       matrix sol(row,col);
+       try {
+               sol = this->solve(vars,identity);
+       } catch (const std::runtime_error & e) {
+           if (e.what()==std::string("matrix::solve(): inconsistent linear system"))
+                       throw (std::runtime_error("matrix::inverse(): singular matrix"));
+               else
+                       throw;
+       }
+       return sol;
+}
+
+
+/** Solve a linear system consisting of a m x n matrix and a m x p right hand
+ *  side by applying an elimination scheme to the augmented matrix.
  *
- *  @param vars n x p matrix
+ *  @param vars n x p matrix, all elements must be symbols 
  *  @param rhs m x p matrix
+ *  @param algo selects the solving algorithm
+ *  @return n x p solution matrix
  *  @exception logic_error (incompatible matrices)
- *  @exception runtime_error (singular matrix) */
-matrix matrix::fraction_free_elim(matrix const & vars,
-                                  matrix const & rhs) const
-{
-    if ((row != rhs.row) || (col != vars.row) || (rhs.col != vars.col)) {
-        throw (std::logic_error("matrix::solve(): incompatible matrices"));
-    }
-    
-    matrix a(*this); // make a copy of the matrix
-    matrix b(rhs);     // make a copy of the rhs vector
-    
-    // given an m x n matrix a, reduce it to upper echelon form
-    int m=a.row;
-    int n=a.col;
-    int sign=1;
-    ex divisor=1;
-    int r=1;
-    
-    // eliminate below row r, with pivot in column k
-    for (int k=1; (k<=n)&&(r<=m); ++k) {
-        // find a nonzero pivot
-        int p;
-        for (p=r; (p<=m)&&(a.ffe_get(p,k).is_equal(exZERO())); ++p) {}
-        // pivot is in row p
-        if (p<=m) {
-            if (p!=r) {
-                // switch rows p and r
-                for (int j=k; j<=n; ++j) {
-                    a.ffe_swap(p,j,r,j);
-                }
-                b.ffe_swap(p,1,r,1);
-                // keep track of sign changes due to row exchange
-                sign=-sign;
-            }
-            for (int i=r+1; i<=m; ++i) {
-                for (int j=k+1; j<=n; ++j) {
-                    a.ffe_set(i,j,(a.ffe_get(r,k)*a.ffe_get(i,j)
-                                  -a.ffe_get(r,j)*a.ffe_get(i,k))/divisor);
-                    a.ffe_set(i,j,a.ffe_get(i,j).normal() /*.normal() */ );
-                }
-                b.ffe_set(i,1,(a.ffe_get(r,k)*b.ffe_get(i,1)
-                              -b.ffe_get(r,1)*a.ffe_get(i,k))/divisor);
-                b.ffe_set(i,1,b.ffe_get(i,1).normal() /*.normal() */ );
-                a.ffe_set(i,k,0);
-            }
-            divisor=a.ffe_get(r,k);
-            r++;
-        }
-    }
-    // optionally compute the determinant for square or augmented matrices
-    // if (r==m+1) { det=sign*divisor; } else { det=0; }
-    
-    /*
-    for (int r=1; r<=m; ++r) {
-        for (int c=1; c<=n; ++c) {
-            cout << a.ffe_get(r,c) << "\t";
-        }
-        cout << " | " <<  b.ffe_get(r,1) << endl;
-    }
-    */
-    
-#ifdef DO_GINAC_ASSERT
-    // test if we really have an upper echelon matrix
-    int zero_in_last_row=-1;
-    for (int r=1; r<=m; ++r) {
-        int zero_in_this_row=0;
-        for (int c=1; c<=n; ++c) {
-            if (a.ffe_get(r,c).is_equal(exZERO())) {
-               zero_in_this_row++;
-            } else {
-                break;
-            }
-        }
-        GINAC_ASSERT((zero_in_this_row>zero_in_last_row)||(zero_in_this_row=n));
-        zero_in_last_row=zero_in_this_row;
-    }
-#endif // def DO_GINAC_ASSERT
-    
-    // assemble solution
-    matrix sol(n,1);
-    int last_assigned_sol=n+1;
-    for (int r=m; r>0; --r) {
-        int first_non_zero=1;
-        while ((first_non_zero<=n)&&(a.ffe_get(r,first_non_zero).is_zero())) {
-            first_non_zero++;
-        }
-        if (first_non_zero>n) {
-            // row consists only of zeroes, corresponding rhs must be 0 as well
-            if (!b.ffe_get(r,1).is_zero()) {
-                throw (std::runtime_error("matrix::fraction_free_elim(): singular matrix"));
-            }
-        } else {
-            // assign solutions for vars between first_non_zero+1 and
-            // last_assigned_sol-1: free parameters
-            for (int c=first_non_zero+1; c<=last_assigned_sol-1; ++c) {
-                sol.ffe_set(c,1,vars.ffe_get(c,1));
-            }
-            ex e=b.ffe_get(r,1);
-            for (int c=first_non_zero+1; c<=n; ++c) {
-                e=e-a.ffe_get(r,c)*sol.ffe_get(c,1);
-            }
-            sol.ffe_set(first_non_zero,1,
-                        (e/a.ffe_get(r,first_non_zero)).normal());
-            last_assigned_sol=first_non_zero;
-        }
-    }
-    // assign solutions for vars between 1 and
-    // last_assigned_sol-1: free parameters
-    for (int c=1; c<=last_assigned_sol-1; ++c) {
-        sol.ffe_set(c,1,vars.ffe_get(c,1));
-    }
-
-    /*
-    for (int c=1; c<=n; ++c) {
-        cout << vars.ffe_get(c,1) << "->" << sol.ffe_get(c,1) << endl;
-    }
-    */
-    
-#ifdef DO_GINAC_ASSERT
-    // test solution with echelon matrix
-    for (int r=1; r<=m; ++r) {
-        ex e=0;
-        for (int c=1; c<=n; ++c) {
-            e=e+a.ffe_get(r,c)*sol.ffe_get(c,1);
-        }
-        if (!(e-b.ffe_get(r,1)).normal().is_zero()) {
-            cout << "e=" << e;
-            cout << "b.ffe_get(" << r<<",1)=" << b.ffe_get(r,1) << endl;
-            cout << "diff=" << (e-b.ffe_get(r,1)).normal() << endl;
-        }
-        GINAC_ASSERT((e-b.ffe_get(r,1)).normal().is_zero());
-    }
-
-    // test solution with original matrix
-    for (int r=1; r<=m; ++r) {
-        ex e=0;
-        for (int c=1; c<=n; ++c) {
-            e=e+ffe_get(r,c)*sol.ffe_get(c,1);
-        }
-        try {
-        if (!(e-rhs.ffe_get(r,1)).normal().is_zero()) {
-            cout << "e=" << e << endl;
-            e.printtree(cout);
-            ex en=e.normal();
-            cout << "e.normal()=" << en << endl;
-            en.printtree(cout);
-            cout << "rhs.ffe_get(" << r<<",1)=" << rhs.ffe_get(r,1) << endl;
-            cout << "diff=" << (e-rhs.ffe_get(r,1)).normal() << endl;
-        }
-        } catch (...) {
-            ex xxx=e-rhs.ffe_get(r,1);
-            cerr << "xxx=" << xxx << endl << endl;
-        }
-        GINAC_ASSERT((e-rhs.ffe_get(r,1)).normal().is_zero());
-    }
-#endif // def DO_GINAC_ASSERT
-    
-    return sol;
-}   
-    
-/** Solve simultaneous set of equations. */
-matrix matrix::solve(matrix const & v) const
-{
-    if (!(row == col && col == v.row)) {
-        throw (std::logic_error("matrix::solve(): incompatible matrices"));
-    }
-    
-    // build the extended matrix of *this with v attached to the right
-    matrix tmp(row,col+v.col);
-    for (int r=0; r<row; ++r) {
-        for (int c=0; c<col; ++c) {
-            tmp.m[r*tmp.col+c] = m[r*col+c];
-        }
-        for (int c=0; c<v.col; ++c) {
-            tmp.m[r*tmp.col+c+col] = v.m[r*v.col+c];
-        }
-    }
-    for (int r1=0; r1<row; ++r1) {
-        int indx = tmp.pivot(r1);
-        if (indx == -1) {
-            throw (std::runtime_error("matrix::solve(): singular matrix"));
-        }
-        for (int c=r1; c<tmp.col; ++c) {
-            tmp.m[r1*tmp.col+c] /= tmp.m[r1*tmp.col+r1];
-        }
-        for (int r2=r1+1; r2<row; ++r2) {
-            for (int c=r1; c<tmp.col; ++c) {
-                tmp.m[r2*tmp.col+c]
-                    -= tmp.m[r2*tmp.col+r1] * tmp.m[r1*tmp.col+c];
-            }
-        }
-    }
-    
-    // assemble the solution matrix
-    vector<ex> sol(v.row*v.col);
-    for (int c=0; c<v.col; ++c) {
-        for (int r=col-1; r>=0; --r) {
-            sol[r*v.col+c] = tmp[r*tmp.col+c];
-            for (int i=r+1; i<col; ++i) {
-                sol[r*v.col+c]
-                    -= tmp[r*tmp.col+i] * sol[i*v.col+c];
-            }
-        }
-    }
-    return matrix(v.row, v.col, sol);
+ *  @exception invalid_argument (1st argument must be matrix of symbols)
+ *  @exception runtime_error (inconsistent linear system)
+ *  @see       solve_algo */
+matrix matrix::solve(const matrix & vars,
+                     const matrix & rhs,
+                     unsigned algo) const
+{
+       const unsigned m = this->rows();
+       const unsigned n = this->cols();
+       const unsigned p = rhs.cols();
+       
+       // syntax checks    
+       if ((rhs.rows() != m) || (vars.rows() != n) || (vars.col != p))
+               throw (std::logic_error("matrix::solve(): incompatible matrices"));
+       for (unsigned ro=0; ro<n; ++ro)
+               for (unsigned co=0; co<p; ++co)
+                       if (!vars(ro,co).info(info_flags::symbol))
+                               throw (std::invalid_argument("matrix::solve(): 1st argument must be matrix of symbols"));
+       
+       // build the augmented matrix of *this with rhs attached to the right
+       matrix aug(m,n+p);
+       for (unsigned r=0; r<m; ++r) {
+               for (unsigned c=0; c<n; ++c)
+                       aug.m[r*(n+p)+c] = this->m[r*n+c];
+               for (unsigned c=0; c<p; ++c)
+                       aug.m[r*(n+p)+c+n] = rhs.m[r*p+c];
+       }
+       
+       // Gather some statistical information about the augmented matrix:
+       bool numeric_flag = true;
+       exvector::const_iterator r = aug.m.begin(), rend = aug.m.end();
+       while (r!=rend && numeric_flag==true) {
+               if (!r->info(info_flags::numeric))
+                       numeric_flag = false;
+               ++r;
+       }
+       
+       // Here is the heuristics in case this routine has to decide:
+       if (algo == solve_algo::automatic) {
+               // Bareiss (fraction-free) elimination is generally a good guess:
+               algo = solve_algo::bareiss;
+               // For m<3, Bareiss elimination is equivalent to division free
+               // elimination but has more logistic overhead
+               if (m<3)
+                       algo = solve_algo::divfree;
+               // This overrides any prior decisions.
+               if (numeric_flag)
+                       algo = solve_algo::gauss;
+       }
+       
+       // Eliminate the augmented matrix:
+       switch(algo) {
+               case solve_algo::gauss:
+                       aug.gauss_elimination();
+                       break;
+               case solve_algo::divfree:
+                       aug.division_free_elimination();
+                       break;
+               case solve_algo::bareiss:
+               default:
+                       aug.fraction_free_elimination();
+       }
+       
+       // assemble the solution matrix:
+       matrix sol(n,p);
+       for (unsigned co=0; co<p; ++co) {
+               unsigned last_assigned_sol = n+1;
+               for (int r=m-1; r>=0; --r) {
+                       unsigned fnz = 1;    // first non-zero in row
+                       while ((fnz<=n) && (aug.m[r*(n+p)+(fnz-1)].is_zero()))
+                               ++fnz;
+                       if (fnz>n) {
+                               // row consists only of zeros, corresponding rhs must be 0, too
+                               if (!aug.m[r*(n+p)+n+co].is_zero()) {
+                                       throw (std::runtime_error("matrix::solve(): inconsistent linear system"));
+                               }
+                       } else {
+                               // assign solutions for vars between fnz+1 and
+                               // last_assigned_sol-1: free parameters
+                               for (unsigned c=fnz; c<last_assigned_sol-1; ++c)
+                                       sol(c,co) = vars.m[c*p+co];
+                               ex e = aug.m[r*(n+p)+n+co];
+                               for (unsigned c=fnz; c<n; ++c)
+                                       e -= aug.m[r*(n+p)+c]*sol.m[c*p+co];
+                               sol(fnz-1,co) = (e/(aug.m[r*(n+p)+(fnz-1)])).normal();
+                               last_assigned_sol = fnz;
+                       }
+               }
+               // assign solutions for vars between 1 and
+               // last_assigned_sol-1: free parameters
+               for (unsigned ro=0; ro<last_assigned_sol-1; ++ro)
+                       sol(ro,co) = vars(ro,co);
+       }
+       
+       return sol;
+}
+
+
+/** Compute the rank of this matrix. */
+unsigned matrix::rank() const
+{
+       // Method:
+       // Transform this matrix into upper echelon form and then count the
+       // number of non-zero rows.
+
+       GINAC_ASSERT(row*col==m.capacity());
+
+       // Actually, any elimination scheme will do since we are only
+       // interested in the echelon matrix' zeros.
+       matrix to_eliminate = *this;
+       to_eliminate.fraction_free_elimination();
+
+       unsigned r = row*col;  // index of last non-zero element
+       while (r--) {
+               if (!to_eliminate.m[r].is_zero())
+                       return 1+r/col;
+       }
+       return 0;
 }
 
+
 // protected
 
-/** Partial pivoting method.
- *  Usual pivoting returns the index to the element with the largest absolute
- *  value and swaps the current row with the one where the element was found.
- *  Here it does the same with the first non-zero element. (This works fine,
- *  but may be far from optimal for numerics.) */
-int matrix::pivot(int ro)
-{
-    int k=ro;
-    
-    for (int r=ro; r<row; ++r) {
-        if (!m[r*col+ro].is_zero()) {
-            k = r;
-            break;
-        }
-    }
-    if (m[k*col+ro].is_zero()) {
-        return -1;
-    }
-    if (k!=ro) {  // swap rows
-        for (int c=0; c<col; ++c) {
-            m[k*col+c].swap(m[ro*col+c]);
-        }
-        return k;
-    }
-    return 0;
+/** Recursive determinant for small matrices having at least one symbolic
+ *  entry.  The basic algorithm, known as Laplace-expansion, is enhanced by
+ *  some bookkeeping to avoid calculation of the same submatrices ("minors")
+ *  more than once.  According to W.M.Gentleman and S.C.Johnson this algorithm
+ *  is better than elimination schemes for matrices of sparse multivariate
+ *  polynomials and also for matrices of dense univariate polynomials if the
+ *  matrix' dimesion is larger than 7.
+ *
+ *  @return the determinant as a new expression (in expanded form)
+ *  @see matrix::determinant() */
+ex matrix::determinant_minor() const
+{
+       // for small matrices the algorithm does not make any sense:
+       const unsigned n = this->cols();
+       if (n==1)
+               return m[0].expand();
+       if (n==2)
+               return (m[0]*m[3]-m[2]*m[1]).expand();
+       if (n==3)
+               return (m[0]*m[4]*m[8]-m[0]*m[5]*m[7]-
+                       m[1]*m[3]*m[8]+m[2]*m[3]*m[7]+
+                       m[1]*m[5]*m[6]-m[2]*m[4]*m[6]).expand();
+       
+       // This algorithm can best be understood by looking at a naive
+       // implementation of Laplace-expansion, like this one:
+       // ex det;
+       // matrix minorM(this->rows()-1,this->cols()-1);
+       // for (unsigned r1=0; r1<this->rows(); ++r1) {
+       //     // shortcut if element(r1,0) vanishes
+       //     if (m[r1*col].is_zero())
+       //         continue;
+       //     // assemble the minor matrix
+       //     for (unsigned r=0; r<minorM.rows(); ++r) {
+       //         for (unsigned c=0; c<minorM.cols(); ++c) {
+       //             if (r<r1)
+       //                 minorM(r,c) = m[r*col+c+1];
+       //             else
+       //                 minorM(r,c) = m[(r+1)*col+c+1];
+       //         }
+       //     }
+       //     // recurse down and care for sign:
+       //     if (r1%2)
+       //         det -= m[r1*col] * minorM.determinant_minor();
+       //     else
+       //         det += m[r1*col] * minorM.determinant_minor();
+       // }
+       // return det.expand();
+       // What happens is that while proceeding down many of the minors are
+       // computed more than once.  In particular, there are binomial(n,k)
+       // kxk minors and each one is computed factorial(n-k) times.  Therefore
+       // it is reasonable to store the results of the minors.  We proceed from
+       // right to left.  At each column c we only need to retrieve the minors
+       // calculated in step c-1.  We therefore only have to store at most 
+       // 2*binomial(n,n/2) minors.
+       
+       // Unique flipper counter for partitioning into minors
+       std::vector<unsigned> Pkey;
+       Pkey.reserve(n);
+       // key for minor determinant (a subpartition of Pkey)
+       std::vector<unsigned> Mkey;
+       Mkey.reserve(n-1);
+       // we store our subminors in maps, keys being the rows they arise from
+       typedef std::map<std::vector<unsigned>,class ex> Rmap;
+       typedef std::map<std::vector<unsigned>,class ex>::value_type Rmap_value;
+       Rmap A;
+       Rmap B;
+       ex det;
+       // initialize A with last column:
+       for (unsigned r=0; r<n; ++r) {
+               Pkey.erase(Pkey.begin(),Pkey.end());
+               Pkey.push_back(r);
+               A.insert(Rmap_value(Pkey,m[n*(r+1)-1]));
+       }
+       // proceed from right to left through matrix
+       for (int c=n-2; c>=0; --c) {
+               Pkey.erase(Pkey.begin(),Pkey.end());  // don't change capacity
+               Mkey.erase(Mkey.begin(),Mkey.end());
+               for (unsigned i=0; i<n-c; ++i)
+                       Pkey.push_back(i);
+               unsigned fc = 0;  // controls logic for our strange flipper counter
+               do {
+                       det = _ex0;
+                       for (unsigned r=0; r<n-c; ++r) {
+                               // maybe there is nothing to do?
+                               if (m[Pkey[r]*n+c].is_zero())
+                                       continue;
+                               // create the sorted key for all possible minors
+                               Mkey.erase(Mkey.begin(),Mkey.end());
+                               for (unsigned i=0; i<n-c; ++i)
+                                       if (i!=r)
+                                               Mkey.push_back(Pkey[i]);
+                               // Fetch the minors and compute the new determinant
+                               if (r%2)
+                                       det -= m[Pkey[r]*n+c]*A[Mkey];
+                               else
+                                       det += m[Pkey[r]*n+c]*A[Mkey];
+                       }
+                       // prevent build-up of deep nesting of expressions saves time:
+                       det = det.expand();
+                       // store the new determinant at its place in B:
+                       if (!det.is_zero())
+                               B.insert(Rmap_value(Pkey,det));
+                       // increment our strange flipper counter
+                       for (fc=n-c; fc>0; --fc) {
+                               ++Pkey[fc-1];
+                               if (Pkey[fc-1]<fc+c)
+                                       break;
+                       }
+                       if (fc<n-c && fc>0)
+                               for (unsigned j=fc; j<n-c; ++j)
+                                       Pkey[j] = Pkey[j-1]+1;
+               } while(fc);
+               // next column, so change the role of A and B:
+               A.swap(B);
+               B.clear();
+       }
+       
+       return det;
 }
 
-//////////
-// global constants
-//////////
 
-const matrix some_matrix;
-type_info const & typeid_matrix=typeid(some_matrix);
+/** Perform the steps of an ordinary Gaussian elimination to bring the m x n
+ *  matrix into an upper echelon form.  The algorithm is ok for matrices
+ *  with numeric coefficients but quite unsuited for symbolic matrices.
+ *
+ *  @param det may be set to true to save a lot of space if one is only
+ *  interested in the diagonal elements (i.e. for calculating determinants).
+ *  The others are set to zero in this case.
+ *  @return sign is 1 if an even number of rows was swapped, -1 if an odd
+ *  number of rows was swapped and 0 if the matrix is singular. */
+int matrix::gauss_elimination(const bool det)
+{
+       ensure_if_modifiable();
+       const unsigned m = this->rows();
+       const unsigned n = this->cols();
+       GINAC_ASSERT(!det || n==m);
+       int sign = 1;
+       
+       unsigned r0 = 0;
+       for (unsigned c0=0; c0<n && r0<m-1; ++c0) {
+               int indx = pivot(r0, c0, true);
+               if (indx == -1) {
+                       sign = 0;
+                       if (det)
+                               return 0;  // leaves *this in a messy state
+               }
+               if (indx>=0) {
+                       if (indx > 0)
+                               sign = -sign;
+                       for (unsigned r2=r0+1; r2<m; ++r2) {
+                               if (!this->m[r2*n+c0].is_zero()) {
+                                       // yes, there is something to do in this row
+                                       ex piv = this->m[r2*n+c0] / this->m[r0*n+c0];
+                                       for (unsigned c=c0+1; c<n; ++c) {
+                                               this->m[r2*n+c] -= piv * this->m[r0*n+c];
+                                               if (!this->m[r2*n+c].info(info_flags::numeric))
+                                                       this->m[r2*n+c] = this->m[r2*n+c].normal();
+                                       }
+                               }
+                               // fill up left hand side with zeros
+                               for (unsigned c=r0; c<=c0; ++c)
+                                       this->m[r2*n+c] = _ex0;
+                       }
+                       if (det) {
+                               // save space by deleting no longer needed elements
+                               for (unsigned c=r0+1; c<n; ++c)
+                                       this->m[r0*n+c] = _ex0;
+                       }
+                       ++r0;
+               }
+       }
+       // clear remaining rows
+       for (unsigned r=r0+1; r<m; ++r) {
+               for (unsigned c=0; c<n; ++c)
+                       this->m[r*n+c] = _ex0;
+       }
+
+       return sign;
+}
+
+
+/** Perform the steps of division free elimination to bring the m x n matrix
+ *  into an upper echelon form.
+ *
+ *  @param det may be set to true to save a lot of space if one is only
+ *  interested in the diagonal elements (i.e. for calculating determinants).
+ *  The others are set to zero in this case.
+ *  @return sign is 1 if an even number of rows was swapped, -1 if an odd
+ *  number of rows was swapped and 0 if the matrix is singular. */
+int matrix::division_free_elimination(const bool det)
+{
+       ensure_if_modifiable();
+       const unsigned m = this->rows();
+       const unsigned n = this->cols();
+       GINAC_ASSERT(!det || n==m);
+       int sign = 1;
+       
+       unsigned r0 = 0;
+       for (unsigned c0=0; c0<n && r0<m-1; ++c0) {
+               int indx = pivot(r0, c0, true);
+               if (indx==-1) {
+                       sign = 0;
+                       if (det)
+                               return 0;  // leaves *this in a messy state
+               }
+               if (indx>=0) {
+                       if (indx>0)
+                               sign = -sign;
+                       for (unsigned r2=r0+1; r2<m; ++r2) {
+                               for (unsigned c=c0+1; c<n; ++c)
+                                       this->m[r2*n+c] = (this->m[r0*n+c0]*this->m[r2*n+c] - this->m[r2*n+c0]*this->m[r0*n+c]).expand();
+                               // fill up left hand side with zeros
+                               for (unsigned c=r0; c<=c0; ++c)
+                                       this->m[r2*n+c] = _ex0;
+                       }
+                       if (det) {
+                               // save space by deleting no longer needed elements
+                               for (unsigned c=r0+1; c<n; ++c)
+                                       this->m[r0*n+c] = _ex0;
+                       }
+                       ++r0;
+               }
+       }
+       // clear remaining rows
+       for (unsigned r=r0+1; r<m; ++r) {
+               for (unsigned c=0; c<n; ++c)
+                       this->m[r*n+c] = _ex0;
+       }
+
+       return sign;
+}
+
+
+/** Perform the steps of Bareiss' one-step fraction free elimination to bring
+ *  the matrix into an upper echelon form.  Fraction free elimination means
+ *  that divide is used straightforwardly, without computing GCDs first.  This
+ *  is possible, since we know the divisor at each step.
+ *  
+ *  @param det may be set to true to save a lot of space if one is only
+ *  interested in the last element (i.e. for calculating determinants). The
+ *  others are set to zero in this case.
+ *  @return sign is 1 if an even number of rows was swapped, -1 if an odd
+ *  number of rows was swapped and 0 if the matrix is singular. */
+int matrix::fraction_free_elimination(const bool det)
+{
+       // Method:
+       // (single-step fraction free elimination scheme, already known to Jordan)
+       //
+       // Usual division-free elimination sets m[0](r,c) = m(r,c) and then sets
+       //     m[k+1](r,c) = m[k](k,k) * m[k](r,c) - m[k](r,k) * m[k](k,c).
+       //
+       // Bareiss (fraction-free) elimination in addition divides that element
+       // by m[k-1](k-1,k-1) for k>1, where it can be shown by means of the
+       // Sylvester identity that this really divides m[k+1](r,c).
+       //
+       // We also allow rational functions where the original prove still holds.
+       // However, we must care for numerator and denominator separately and
+       // "manually" work in the integral domains because of subtle cancellations
+       // (see below).  This blows up the bookkeeping a bit and the formula has
+       // to be modified to expand like this (N{x} stands for numerator of x,
+       // D{x} for denominator of x):
+       //     N{m[k+1](r,c)} = N{m[k](k,k)}*N{m[k](r,c)}*D{m[k](r,k)}*D{m[k](k,c)}
+       //                     -N{m[k](r,k)}*N{m[k](k,c)}*D{m[k](k,k)}*D{m[k](r,c)}
+       //     D{m[k+1](r,c)} = D{m[k](k,k)}*D{m[k](r,c)}*D{m[k](r,k)}*D{m[k](k,c)}
+       // where for k>1 we now divide N{m[k+1](r,c)} by
+       //     N{m[k-1](k-1,k-1)}
+       // and D{m[k+1](r,c)} by
+       //     D{m[k-1](k-1,k-1)}.
+       
+       ensure_if_modifiable();
+       const unsigned m = this->rows();
+       const unsigned n = this->cols();
+       GINAC_ASSERT(!det || n==m);
+       int sign = 1;
+       if (m==1)
+               return 1;
+       ex divisor_n = 1;
+       ex divisor_d = 1;
+       ex dividend_n;
+       ex dividend_d;
+       
+       // We populate temporary matrices to subsequently operate on.  There is
+       // one holding numerators and another holding denominators of entries.
+       // This is a must since the evaluator (or even earlier mul's constructor)
+       // might cancel some trivial element which causes divide() to fail.  The
+       // elements are normalized first (yes, even though this algorithm doesn't
+       // need GCDs) since the elements of *this might be unnormalized, which
+       // makes things more complicated than they need to be.
+       matrix tmp_n(*this);
+       matrix tmp_d(m,n);  // for denominators, if needed
+       exmap srl;  // symbol replacement list
+       exvector::const_iterator cit = this->m.begin(), citend = this->m.end();
+       exvector::iterator tmp_n_it = tmp_n.m.begin(), tmp_d_it = tmp_d.m.begin();
+       while (cit != citend) {
+               ex nd = cit->normal().to_rational(srl).numer_denom();
+               ++cit;
+               *tmp_n_it++ = nd.op(0);
+               *tmp_d_it++ = nd.op(1);
+       }
+       
+       unsigned r0 = 0;
+       for (unsigned c0=0; c0<n && r0<m-1; ++c0) {
+               int indx = tmp_n.pivot(r0, c0, true);
+               if (indx==-1) {
+                       sign = 0;
+                       if (det)
+                               return 0;
+               }
+               if (indx>=0) {
+                       if (indx>0) {
+                               sign = -sign;
+                               // tmp_n's rows r0 and indx were swapped, do the same in tmp_d:
+                               for (unsigned c=c0; c<n; ++c)
+                                       tmp_d.m[n*indx+c].swap(tmp_d.m[n*r0+c]);
+                       }
+                       for (unsigned r2=r0+1; r2<m; ++r2) {
+                               for (unsigned c=c0+1; c<n; ++c) {
+                                       dividend_n = (tmp_n.m[r0*n+c0]*tmp_n.m[r2*n+c]*
+                                                     tmp_d.m[r2*n+c0]*tmp_d.m[r0*n+c]
+                                                    -tmp_n.m[r2*n+c0]*tmp_n.m[r0*n+c]*
+                                                     tmp_d.m[r0*n+c0]*tmp_d.m[r2*n+c]).expand();
+                                       dividend_d = (tmp_d.m[r2*n+c0]*tmp_d.m[r0*n+c]*
+                                                     tmp_d.m[r0*n+c0]*tmp_d.m[r2*n+c]).expand();
+                                       bool check = divide(dividend_n, divisor_n,
+                                                           tmp_n.m[r2*n+c], true);
+                                       check &= divide(dividend_d, divisor_d,
+                                                       tmp_d.m[r2*n+c], true);
+                                       GINAC_ASSERT(check);
+                               }
+                               // fill up left hand side with zeros
+                               for (unsigned c=r0; c<=c0; ++c)
+                                       tmp_n.m[r2*n+c] = _ex0;
+                       }
+                       if (c0<n && r0<m-1) {
+                               // compute next iteration's divisor
+                               divisor_n = tmp_n.m[r0*n+c0].expand();
+                               divisor_d = tmp_d.m[r0*n+c0].expand();
+                               if (det) {
+                                       // save space by deleting no longer needed elements
+                                       for (unsigned c=0; c<n; ++c) {
+                                               tmp_n.m[r0*n+c] = _ex0;
+                                               tmp_d.m[r0*n+c] = _ex1;
+                                       }
+                               }
+                       }
+                       ++r0;
+               }
+       }
+       // clear remaining rows
+       for (unsigned r=r0+1; r<m; ++r) {
+               for (unsigned c=0; c<n; ++c)
+                       tmp_n.m[r*n+c] = _ex0;
+       }
+
+       // repopulate *this matrix:
+       exvector::iterator it = this->m.begin(), itend = this->m.end();
+       tmp_n_it = tmp_n.m.begin();
+       tmp_d_it = tmp_d.m.begin();
+       while (it != itend)
+               *it++ = ((*tmp_n_it++)/(*tmp_d_it++)).subs(srl, subs_options::no_pattern);
+       
+       return sign;
+}
+
+
+/** Partial pivoting method for matrix elimination schemes.
+ *  Usual pivoting (symbolic==false) returns the index to the element with the
+ *  largest absolute value in column ro and swaps the current row with the one
+ *  where the element was found.  With (symbolic==true) it does the same thing
+ *  with the first non-zero element.
+ *
+ *  @param ro is the row from where to begin
+ *  @param co is the column to be inspected
+ *  @param symbolic signal if we want the first non-zero element to be pivoted
+ *  (true) or the one with the largest absolute value (false).
+ *  @return 0 if no interchange occured, -1 if all are zero (usually signaling
+ *  a degeneracy) and positive integer k means that rows ro and k were swapped.
+ */
+int matrix::pivot(unsigned ro, unsigned co, bool symbolic)
+{
+       unsigned k = ro;
+       if (symbolic) {
+               // search first non-zero element in column co beginning at row ro
+               while ((k<row) && (this->m[k*col+co].expand().is_zero()))
+                       ++k;
+       } else {
+               // search largest element in column co beginning at row ro
+               GINAC_ASSERT(is_exactly_a<numeric>(this->m[k*col+co]));
+               unsigned kmax = k+1;
+               numeric mmax = abs(ex_to<numeric>(m[kmax*col+co]));
+               while (kmax<row) {
+                       GINAC_ASSERT(is_exactly_a<numeric>(this->m[kmax*col+co]));
+                       numeric tmp = ex_to<numeric>(this->m[kmax*col+co]);
+                       if (abs(tmp) > mmax) {
+                               mmax = tmp;
+                               k = kmax;
+                       }
+                       ++kmax;
+               }
+               if (!mmax.is_zero())
+                       k = kmax;
+       }
+       if (k==row)
+               // all elements in column co below row ro vanish
+               return -1;
+       if (k==ro)
+               // matrix needs no pivoting
+               return 0;
+       // matrix needs pivoting, so swap rows k and ro
+       ensure_if_modifiable();
+       for (unsigned c=0; c<col; ++c)
+               this->m[k*col+c].swap(this->m[ro*col+c]);
+       
+       return k;
+}
+
+ex lst_to_matrix(const lst & l)
+{
+       lst::const_iterator itr, itc;
+
+       // Find number of rows and columns
+       size_t rows = l.nops(), cols = 0;
+       for (itr = l.begin(); itr != l.end(); ++itr) {
+               if (!is_a<lst>(*itr))
+                       throw (std::invalid_argument("lst_to_matrix: argument must be a list of lists"));
+               if (itr->nops() > cols)
+                       cols = itr->nops();
+       }
+
+       // Allocate and fill matrix
+       matrix &M = *new matrix(rows, cols);
+       M.setflag(status_flags::dynallocated);
+
+       unsigned i;
+       for (itr = l.begin(), i = 0; itr != l.end(); ++itr, ++i) {
+               unsigned j;
+               for (itc = ex_to<lst>(*itr).begin(), j = 0; itc != ex_to<lst>(*itr).end(); ++itc, ++j)
+                       M(i, j) = *itc;
+       }
+
+       return M;
+}
+
+ex diag_matrix(const lst & l)
+{
+       lst::const_iterator it;
+       size_t dim = l.nops();
+
+       // Allocate and fill matrix
+       matrix &M = *new matrix(dim, dim);
+       M.setflag(status_flags::dynallocated);
+
+       unsigned i;
+       for (it = l.begin(), i = 0; it != l.end(); ++it, ++i)
+               M(i, i) = *it;
+
+       return M;
+}
+
+ex unit_matrix(unsigned r, unsigned c)
+{
+       matrix &Id = *new matrix(r, c);
+       Id.setflag(status_flags::dynallocated);
+       for (unsigned i=0; i<r && i<c; i++)
+               Id(i,i) = _ex1;
+
+       return Id;
+}
+
+ex symbolic_matrix(unsigned r, unsigned c, const std::string & base_name, const std::string & tex_base_name)
+{
+       matrix &M = *new matrix(r, c);
+       M.setflag(status_flags::dynallocated | status_flags::evaluated);
+
+       bool long_format = (r > 10 || c > 10);
+       bool single_row = (r == 1 || c == 1);
+
+       for (unsigned i=0; i<r; i++) {
+               for (unsigned j=0; j<c; j++) {
+                       std::ostringstream s1, s2;
+                       s1 << base_name;
+                       s2 << tex_base_name << "_{";
+                       if (single_row) {
+                               if (c == 1) {
+                                       s1 << i;
+                                       s2 << i << '}';
+                               } else {
+                                       s1 << j;
+                                       s2 << j << '}';
+                               }
+                       } else {
+                               if (long_format) {
+                                       s1 << '_' << i << '_' << j;
+                                       s2 << i << ';' << j << "}";
+                               } else {
+                                       s1 << i << j;
+                                       s2 << i << j << '}';
+                               }
+                       }
+                       M(i, j) = symbol(s1.str(), s2.str());
+               }
+       }
+
+       return M;
+}
+
+ex reduced_matrix(const matrix& m, unsigned r, unsigned c)
+{
+       if (r+1>m.rows() || c+1>m.cols() || m.cols()<2 || m.rows()<2)
+               throw std::runtime_error("minor_matrix(): index out of bounds");
+
+       const unsigned rows = m.rows()-1;
+       const unsigned cols = m.cols()-1;
+       matrix &M = *new matrix(rows, cols);
+       M.setflag(status_flags::dynallocated | status_flags::evaluated);
+
+       unsigned ro = 0;
+       unsigned ro2 = 0;
+       while (ro2<rows) {
+               if (ro==r)
+                       ++ro;
+               unsigned co = 0;
+               unsigned co2 = 0;
+               while (co2<cols) {
+                       if (co==c)
+                               ++co;
+                       M(ro2,co2) = m(ro, co);
+                       ++co;
+                       ++co2;
+               }
+               ++ro;
+               ++ro2;
+       }
+
+       return M;
+}
+
+ex sub_matrix(const matrix&m, unsigned r, unsigned nr, unsigned c, unsigned nc)
+{
+       if (r+nr>m.rows() || c+nc>m.cols())
+               throw std::runtime_error("sub_matrix(): index out of bounds");
+
+       matrix &M = *new matrix(nr, nc);
+       M.setflag(status_flags::dynallocated | status_flags::evaluated);
+
+       for (unsigned ro=0; ro<nr; ++ro) {
+               for (unsigned co=0; co<nc; ++co) {
+                       M(ro,co) = m(ro+r,co+c);
+               }
+       }
+
+       return M;
+}
 
 } // namespace GiNaC
index 391b80b6dd88c6c77615bda512427b718d175cc1..29d265858ce4fd4b301ce6714fde3858ab7e8592 100644 (file)
@@ -3,11 +3,10 @@
  *  This file implements several functions that work on univariate and
  *  multivariate polynomials and rational functions.
  *  These functions include polynomial quotient and remainder, GCD and LCM
- *  computation, square-free factorization and rational function normalization.
- */
+ *  computation, square-free factorization and rational function normalization. */
 
 /*
- *  GiNaC Copyright (C) 1999 Johannes Gutenberg University Mainz, Germany
+ *  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
  *
  *  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  */
 
-#include <stdexcept>
 #include <algorithm>
 #include <map>
 
 #include "normal.h"
+
 #include "basic.h"
 #include "ex.h"
 #include "add.h"
 #include "constant.h"
 #include "expairseq.h"
 #include "fail.h"
-#include "indexed.h"
 #include "inifcns.h"
 #include "lst.h"
 #include "mul.h"
-#include "ncmul.h"
 #include "numeric.h"
 #include "power.h"
 #include "relational.h"
-#include "series.h"
+#include "operators.h"
+#include "matrix.h"
+#include "pseries.h"
 #include "symbol.h"
+#include "utils.h"
 
 namespace GiNaC {
 
@@ -54,31 +54,58 @@ namespace GiNaC {
 #define FAST_COMPARE 1
 
 // Set this if you want divide_in_z() to use remembering
-#define USE_REMEMBER 1
+#define USE_REMEMBER 0
+
+// Set this if you want divide_in_z() to use trial division followed by
+// polynomial interpolation (always slower except for completely dense
+// polynomials)
+#define USE_TRIAL_DIVISION 0
+
+// Set this to enable some statistical output for the GCD routines
+#define STATISTICS 0
+
+
+#if STATISTICS
+// Statistics variables
+static int gcd_called = 0;
+static int sr_gcd_called = 0;
+static int heur_gcd_called = 0;
+static int heur_gcd_failed = 0;
+
+// Print statistics at end of program
+static struct _stat_print {
+       _stat_print() {}
+       ~_stat_print() {
+               std::cout << "gcd() called " << gcd_called << " times\n";
+               std::cout << "sr_gcd() called " << sr_gcd_called << " times\n";
+               std::cout << "heur_gcd() called " << heur_gcd_called << " times\n";
+               std::cout << "heur_gcd() failed " << heur_gcd_failed << " times\n";
+       }
+} stat_print;
+#endif
 
 
-/** Return pointer to first symbol found in expression.  Due to GiNaC´s
+/** Return pointer to first symbol found in expression.  Due to GiNaC's
  *  internal ordering of terms, it may not be obvious which symbol this
  *  function returns for a given expression.
  *
  *  @param e  expression to search
- *  @param x  pointer to first symbol found (returned)
+ *  @param x  first symbol found (returned)
  *  @return "false" if no symbol was found, "true" otherwise */
-
-static bool get_first_symbol(const ex &e, const symbol *&x)
+static bool get_first_symbol(const ex &e, ex &x)
 {
-    if (is_ex_exactly_of_type(e, symbol)) {
-        x = static_cast<symbol *>(e.bp);
-        return true;
-    } else if (is_ex_exactly_of_type(e, add) || is_ex_exactly_of_type(e, mul)) {
-        for (int i=0; i<e.nops(); i++)
-            if (get_first_symbol(e.op(i), x))
-                return true;
-    } else if (is_ex_exactly_of_type(e, power)) {
-        if (get_first_symbol(e.op(0), x))
-            return true;
-    }
-    return false;
+       if (is_a<symbol>(e)) {
+               x = e;
+               return true;
+       } else if (is_exactly_a<add>(e) || is_exactly_a<mul>(e)) {
+               for (size_t i=0; i<e.nops(); i++)
+                       if (get_first_symbol(e.op(i), x))
+                               return true;
+       } else if (is_exactly_a<power>(e)) {
+               if (get_first_symbol(e.op(0), x))
+                       return true;
+       }
+       return false;
 }
 
 
@@ -93,56 +120,65 @@ static bool get_first_symbol(const ex &e, const symbol *&x)
  *
  *  @see get_symbol_stats */
 struct sym_desc {
-    /** Pointer to symbol */
-    const symbol *sym;
+       /** Reference to symbol */
+       ex sym;
 
-    /** Highest degree of symbol in polynomial "a" */
-    int deg_a;
+       /** Highest degree of symbol in polynomial "a" */
+       int deg_a;
 
-    /** Highest degree of symbol in polynomial "b" */
-    int deg_b;
+       /** Highest degree of symbol in polynomial "b" */
+       int deg_b;
 
-    /** Lowest degree of symbol in polynomial "a" */
-    int ldeg_a;
+       /** Lowest degree of symbol in polynomial "a" */
+       int ldeg_a;
 
-    /** Lowest degree of symbol in polynomial "b" */
-    int ldeg_b;
+       /** Lowest degree of symbol in polynomial "b" */
+       int ldeg_b;
 
-    /** Minimum of ldeg_a and ldeg_b (Used for sorting) */
-    int min_deg;
+       /** Maximum of deg_a and deg_b (Used for sorting) */
+       int max_deg;
 
-    /** Commparison operator for sorting */
-    bool operator<(const sym_desc &x) const {return min_deg < x.min_deg;}
+       /** Maximum number of terms of leading coefficient of symbol in both polynomials */
+       size_t max_lcnops;
+
+       /** Commparison operator for sorting */
+       bool operator<(const sym_desc &x) const
+       {
+               if (max_deg == x.max_deg)
+                       return max_lcnops < x.max_lcnops;
+               else
+                       return max_deg < x.max_deg;
+       }
 };
 
 // Vector of sym_desc structures
-typedef vector<sym_desc> sym_desc_vec;
+typedef std::vector<sym_desc> sym_desc_vec;
 
 // Add symbol the sym_desc_vec (used internally by get_symbol_stats())
-static void add_symbol(const symbol *s, sym_desc_vec &v)
+static void add_symbol(const ex &s, sym_desc_vec &v)
 {
-    sym_desc_vec::iterator it = v.begin(), itend = v.end();
-    while (it != itend) {
-        if (it->sym->compare(*s) == 0)  // If it's already in there, don't add it a second time
-            return;
-        it++;
-    }
-    sym_desc d;
-    d.sym = s;
-    v.push_back(d);
+       sym_desc_vec::const_iterator it = v.begin(), itend = v.end();
+       while (it != itend) {
+               if (it->sym.is_equal(s))  // If it's already in there, don't add it a second time
+                       return;
+               ++it;
+       }
+       sym_desc d;
+       d.sym = s;
+       v.push_back(d);
 }
 
 // Collect all symbols of an expression (used internally by get_symbol_stats())
 static void collect_symbols(const ex &e, sym_desc_vec &v)
 {
-    if (is_ex_exactly_of_type(e, symbol)) {
-        add_symbol(static_cast<symbol *>(e.bp), v);
-    } else if (is_ex_exactly_of_type(e, add) || is_ex_exactly_of_type(e, mul)) {
-        for (int i=0; i<e.nops(); i++)
-            collect_symbols(e.op(i), v);
-    } else if (is_ex_exactly_of_type(e, power)) {
-        collect_symbols(e.op(0), v);
-    }
+       if (is_a<symbol>(e)) {
+               add_symbol(e, v);
+       } else if (is_exactly_a<add>(e) || is_exactly_a<mul>(e)) {
+               for (size_t i=0; i<e.nops(); i++)
+                       collect_symbols(e.op(i), v);
+       } else if (is_exactly_a<power>(e)) {
+               collect_symbols(e.op(0), v);
+       }
 }
 
 /** Collect statistical information about symbols in polynomials.
@@ -157,23 +193,33 @@ static void collect_symbols(const ex &e, sym_desc_vec &v)
  *  @param a  first multivariate polynomial
  *  @param b  second multivariate polynomial
  *  @param v  vector of sym_desc structs (filled in) */
-
 static void get_symbol_stats(const ex &a, const ex &b, sym_desc_vec &v)
 {
-    collect_symbols(a.eval(), v);   // eval() to expand assigned symbols
-    collect_symbols(b.eval(), v);
-    sym_desc_vec::iterator it = v.begin(), itend = v.end();
-    while (it != itend) {
-        int deg_a = a.degree(*(it->sym));
-        int deg_b = b.degree(*(it->sym));
-        it->deg_a = deg_a;
-        it->deg_b = deg_b;
-        it->min_deg = min(deg_a, deg_b);
-        it->ldeg_a = a.ldegree(*(it->sym));
-        it->ldeg_b = b.ldegree(*(it->sym));
-        it++;
-    }
-    sort(v.begin(), v.end());
+       collect_symbols(a.eval(), v);   // eval() to expand assigned symbols
+       collect_symbols(b.eval(), v);
+       sym_desc_vec::iterator it = v.begin(), itend = v.end();
+       while (it != itend) {
+               int deg_a = a.degree(it->sym);
+               int deg_b = b.degree(it->sym);
+               it->deg_a = deg_a;
+               it->deg_b = deg_b;
+               it->max_deg = std::max(deg_a, deg_b);
+               it->max_lcnops = std::max(a.lcoeff(it->sym).nops(), b.lcoeff(it->sym).nops());
+               it->ldeg_a = a.ldegree(it->sym);
+               it->ldeg_b = b.ldegree(it->sym);
+               ++it;
+       }
+       std::sort(v.begin(), v.end());
+
+#if 0
+       std::clog << "Symbols:\n";
+       it = v.begin(); itend = v.end();
+       while (it != itend) {
+               std::clog << " " << it->sym << ": deg_a=" << it->deg_a << ", deg_b=" << it->deg_b << ", ldeg_a=" << it->ldeg_a << ", ldeg_b=" << it->ldeg_b << ", max_deg=" << it->max_deg << ", max_lcnops=" << it->max_lcnops << endl;
+               std::clog << "  lcoeff_a=" << a.lcoeff(it->sym) << ", lcoeff_b=" << b.lcoeff(it->sym) << endl;
+               ++it;
+       }
+#endif
 }
 
 
@@ -185,83 +231,124 @@ static void get_symbol_stats(const ex &a, const ex &b, sym_desc_vec &v)
 // expression recursively (used internally by lcm_of_coefficients_denominators())
 static numeric lcmcoeff(const ex &e, const numeric &l)
 {
-    if (e.info(info_flags::rational))
-        return lcm(ex_to_numeric(e).denom(), l);
-    else if (is_ex_exactly_of_type(e, add) || is_ex_exactly_of_type(e, mul)) {
-        numeric c = numONE();
-        for (int i=0; i<e.nops(); i++) {
-            c = lcmcoeff(e.op(i), c);
-        }
-        return lcm(c, l);
-    } else if (is_ex_exactly_of_type(e, power))
-        return lcmcoeff(e.op(0), l);
-    return l;
+       if (e.info(info_flags::rational))
+               return lcm(ex_to<numeric>(e).denom(), l);
+       else if (is_exactly_a<add>(e)) {
+               numeric c = *_num1_p;
+               for (size_t i=0; i<e.nops(); i++)
+                       c = lcmcoeff(e.op(i), c);
+               return lcm(c, l);
+       } else if (is_exactly_a<mul>(e)) {
+               numeric c = *_num1_p;
+               for (size_t i=0; i<e.nops(); i++)
+                       c *= lcmcoeff(e.op(i), *_num1_p);
+               return lcm(c, l);
+       } else if (is_exactly_a<power>(e)) {
+               if (is_a<symbol>(e.op(0)))
+                       return l;
+               else
+                       return pow(lcmcoeff(e.op(0), l), ex_to<numeric>(e.op(1)));
+       }
+       return l;
 }
 
 /** Compute LCM of denominators of coefficients of a polynomial.
  *  Given a polynomial with rational coefficients, this function computes
  *  the LCM of the denominators of all coefficients. This can be used
- *  To bring a polynomial from Q[X] to Z[X].
+ *  to bring a polynomial from Q[X] to Z[X].
  *
- *  @param e  multivariate polynomial
+ *  @param e  multivariate polynomial (need not be expanded)
  *  @return LCM of denominators of coefficients */
-
 static numeric lcm_of_coefficients_denominators(const ex &e)
 {
-    return lcmcoeff(e.expand(), numONE());
+       return lcmcoeff(e, *_num1_p);
+}
+
+/** Bring polynomial from Q[X] to Z[X] by multiplying in the previously
+ *  determined LCM of the coefficient's denominators.
+ *
+ *  @param e  multivariate polynomial (need not be expanded)
+ *  @param lcm  LCM to multiply in */
+static ex multiply_lcm(const ex &e, const numeric &lcm)
+{
+       if (is_exactly_a<mul>(e)) {
+               size_t num = e.nops();
+               exvector v; v.reserve(num + 1);
+               numeric lcm_accum = *_num1_p;
+               for (size_t i=0; i<num; i++) {
+                       numeric op_lcm = lcmcoeff(e.op(i), *_num1_p);
+                       v.push_back(multiply_lcm(e.op(i), op_lcm));
+                       lcm_accum *= op_lcm;
+               }
+               v.push_back(lcm / lcm_accum);
+               return (new mul(v))->setflag(status_flags::dynallocated);
+       } else if (is_exactly_a<add>(e)) {
+               size_t num = e.nops();
+               exvector v; v.reserve(num);
+               for (size_t i=0; i<num; i++)
+                       v.push_back(multiply_lcm(e.op(i), lcm));
+               return (new add(v))->setflag(status_flags::dynallocated);
+       } else if (is_exactly_a<power>(e)) {
+               if (is_a<symbol>(e.op(0)))
+                       return e * lcm;
+               else
+                       return pow(multiply_lcm(e.op(0), lcm.power(ex_to<numeric>(e.op(1)).inverse())), e.op(1));
+       } else
+               return e * lcm;
 }
 
 
 /** Compute the integer content (= GCD of all numeric coefficients) of an
- *  expanded polynomial.
+ *  expanded polynomial. For a polynomial with rational coefficients, this
+ *  returns g/l where g is the GCD of the coefficients' numerators and l
+ *  is the LCM of the coefficients' denominators.
  *
- *  @param e  expanded polynomial
  *  @return integer content */
-
-numeric ex::integer_content(void) const
+numeric ex::integer_content() const
 {
-    GINAC_ASSERT(bp!=0);
-    return bp->integer_content();
+       return bp->integer_content();
 }
 
-numeric basic::integer_content(void) const
+numeric basic::integer_content() const
 {
-    return numONE();
+       return *_num1_p;
 }
 
-numeric numeric::integer_content(void) const
+numeric numeric::integer_content() const
 {
-    return abs(*this);
+       return abs(*this);
 }
 
-numeric add::integer_content(void) const
+numeric add::integer_content() const
 {
-    epvector::const_iterator it = seq.begin();
-    epvector::const_iterator itend = seq.end();
-    numeric c = numZERO();
-    while (it != itend) {
-        GINAC_ASSERT(!is_ex_exactly_of_type(it->rest,numeric));
-        GINAC_ASSERT(is_ex_exactly_of_type(it->coeff,numeric));
-        c = gcd(ex_to_numeric(it->coeff), c);
-        it++;
-    }
-    GINAC_ASSERT(is_ex_exactly_of_type(overall_coeff,numeric));
-    c = gcd(ex_to_numeric(overall_coeff),c);
-    return c;
+       epvector::const_iterator it = seq.begin();
+       epvector::const_iterator itend = seq.end();
+       numeric c = *_num0_p, l = *_num1_p;
+       while (it != itend) {
+               GINAC_ASSERT(!is_exactly_a<numeric>(it->rest));
+               GINAC_ASSERT(is_exactly_a<numeric>(it->coeff));
+               c = gcd(ex_to<numeric>(it->coeff).numer(), c);
+               l = lcm(ex_to<numeric>(it->coeff).denom(), l);
+               it++;
+       }
+       GINAC_ASSERT(is_exactly_a<numeric>(overall_coeff));
+       c = gcd(ex_to<numeric>(overall_coeff).numer(), c);
+       l = lcm(ex_to<numeric>(overall_coeff).denom(), l);
+       return c/l;
 }
 
-numeric mul::integer_content(void) const
+numeric mul::integer_content() const
 {
 #ifdef DO_GINAC_ASSERT
-    epvector::const_iterator it = seq.begin();
-    epvector::const_iterator itend = seq.end();
-    while (it != itend) {
-        GINAC_ASSERT(!is_ex_exactly_of_type(recombine_pair_to_ex(*it),numeric));
-        ++it;
-    }
+       epvector::const_iterator it = seq.begin();
+       epvector::const_iterator itend = seq.end();
+       while (it != itend) {
+               GINAC_ASSERT(!is_exactly_a<numeric>(recombine_pair_to_ex(*it)));
+               ++it;
+       }
 #endif // def DO_GINAC_ASSERT
-    GINAC_ASSERT(is_ex_exactly_of_type(overall_coeff,numeric));
-    return abs(ex_to_numeric(overall_coeff));
+       GINAC_ASSERT(is_exactly_a<numeric>(overall_coeff));
+       return abs(ex_to<numeric>(overall_coeff));
 }
 
 
@@ -278,45 +365,44 @@ numeric mul::integer_content(void) const
  *  @param check_args  check whether a and b are polynomials with rational
  *         coefficients (defaults to "true")
  *  @return quotient of a and b in Q[x] */
-
-ex quo(const ex &a, const ex &b, const symbol &x, bool check_args)
+ex quo(const ex &a, const ex &b, const ex &x, bool check_args)
 {
-    if (b.is_zero())
-        throw(std::overflow_error("quo: division by zero"));
-    if (is_ex_exactly_of_type(a, numeric) && is_ex_exactly_of_type(b, numeric))
-        return a / b;
+       if (b.is_zero())
+               throw(std::overflow_error("quo: division by zero"));
+       if (is_exactly_a<numeric>(a) && is_exactly_a<numeric>(b))
+               return a / b;
 #if FAST_COMPARE
-    if (a.is_equal(b))
-        return exONE();
+       if (a.is_equal(b))
+               return _ex1;
 #endif
-    if (check_args && (!a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial)))
-        throw(std::invalid_argument("quo: arguments must be polynomials over the rationals"));
-
-    // Polynomial long division
-    ex q = exZERO();
-    ex r = a.expand();
-    if (r.is_zero())
-        return r;
-    int bdeg = b.degree(x);
-    int rdeg = r.degree(x);
-    ex blcoeff = b.expand().coeff(x, bdeg);
-    bool blcoeff_is_numeric = is_ex_exactly_of_type(blcoeff, numeric);
-    while (rdeg >= bdeg) {
-        ex term, rcoeff = r.coeff(x, rdeg);
-        if (blcoeff_is_numeric)
-            term = rcoeff / blcoeff;
-        else {
-            if (!divide(rcoeff, blcoeff, term, false))
-                return *new ex(fail());
-        }
-        term *= power(x, rdeg - bdeg);
-        q += term;
-        r -= (term * b).expand();
-        if (r.is_zero())
-            break;
-        rdeg = r.degree(x);
-    }
-    return q;
+       if (check_args && (!a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial)))
+               throw(std::invalid_argument("quo: arguments must be polynomials over the rationals"));
+
+       // Polynomial long division
+       ex r = a.expand();
+       if (r.is_zero())
+               return r;
+       int bdeg = b.degree(x);
+       int rdeg = r.degree(x);
+       ex blcoeff = b.expand().coeff(x, bdeg);
+       bool blcoeff_is_numeric = is_exactly_a<numeric>(blcoeff);
+       exvector v; v.reserve(std::max(rdeg - bdeg + 1, 0));
+       while (rdeg >= bdeg) {
+               ex term, rcoeff = r.coeff(x, rdeg);
+               if (blcoeff_is_numeric)
+                       term = rcoeff / blcoeff;
+               else {
+                       if (!divide(rcoeff, blcoeff, term, false))
+                               return (new fail())->setflag(status_flags::dynallocated);
+               }
+               term *= power(x, rdeg - bdeg);
+               v.push_back(term);
+               r -= (term * b).expand();
+               if (r.is_zero())
+                       break;
+               rdeg = r.degree(x);
+       }
+       return (new add(v))->setflag(status_flags::dynallocated);
 }
 
 
@@ -329,100 +415,166 @@ ex quo(const ex &a, const ex &b, const symbol &x, bool check_args)
  *  @param check_args  check whether a and b are polynomials with rational
  *         coefficients (defaults to "true")
  *  @return remainder of a(x) and b(x) in Q[x] */
-
-ex rem(const ex &a, const ex &b, const symbol &x, bool check_args)
+ex rem(const ex &a, const ex &b, const ex &x, bool check_args)
 {
-    if (b.is_zero())
-        throw(std::overflow_error("rem: division by zero"));
-    if (is_ex_exactly_of_type(a, numeric)) {
-        if  (is_ex_exactly_of_type(b, numeric))
-            return exZERO();
-        else
-            return b;
-    }
+       if (b.is_zero())
+               throw(std::overflow_error("rem: division by zero"));
+       if (is_exactly_a<numeric>(a)) {
+               if  (is_exactly_a<numeric>(b))
+                       return _ex0;
+               else
+                       return a;
+       }
 #if FAST_COMPARE
-    if (a.is_equal(b))
-        return exZERO();
+       if (a.is_equal(b))
+               return _ex0;
 #endif
-    if (check_args && (!a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial)))
-        throw(std::invalid_argument("rem: arguments must be polynomials over the rationals"));
-
-    // Polynomial long division
-    ex r = a.expand();
-    if (r.is_zero())
-        return r;
-    int bdeg = b.degree(x);
-    int rdeg = r.degree(x);
-    ex blcoeff = b.expand().coeff(x, bdeg);
-    bool blcoeff_is_numeric = is_ex_exactly_of_type(blcoeff, numeric);
-    while (rdeg >= bdeg) {
-        ex term, rcoeff = r.coeff(x, rdeg);
-        if (blcoeff_is_numeric)
-            term = rcoeff / blcoeff;
-        else {
-            if (!divide(rcoeff, blcoeff, term, false))
-                return *new ex(fail());
-        }
-        term *= power(x, rdeg - bdeg);
-        r -= (term * b).expand();
-        if (r.is_zero())
-            break;
-        rdeg = r.degree(x);
-    }
-    return r;
-}
-
-
-/** Pseudo-remainder of polynomials a(x) and b(x) in Z[x].
+       if (check_args && (!a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial)))
+               throw(std::invalid_argument("rem: arguments must be polynomials over the rationals"));
+
+       // Polynomial long division
+       ex r = a.expand();
+       if (r.is_zero())
+               return r;
+       int bdeg = b.degree(x);
+       int rdeg = r.degree(x);
+       ex blcoeff = b.expand().coeff(x, bdeg);
+       bool blcoeff_is_numeric = is_exactly_a<numeric>(blcoeff);
+       while (rdeg >= bdeg) {
+               ex term, rcoeff = r.coeff(x, rdeg);
+               if (blcoeff_is_numeric)
+                       term = rcoeff / blcoeff;
+               else {
+                       if (!divide(rcoeff, blcoeff, term, false))
+                               return (new fail())->setflag(status_flags::dynallocated);
+               }
+               term *= power(x, rdeg - bdeg);
+               r -= (term * b).expand();
+               if (r.is_zero())
+                       break;
+               rdeg = r.degree(x);
+       }
+       return r;
+}
+
+
+/** Decompose rational function a(x)=N(x)/D(x) into P(x)+n(x)/D(x)
+ *  with degree(n, x) < degree(D, x).
+ *
+ *  @param a rational function in x
+ *  @param x a is a function of x
+ *  @return decomposed function. */
+ex decomp_rational(const ex &a, const ex &x)
+{
+       ex nd = numer_denom(a);
+       ex numer = nd.op(0), denom = nd.op(1);
+       ex q = quo(numer, denom, x);
+       if (is_exactly_a<fail>(q))
+               return a;
+       else
+               return q + rem(numer, denom, x) / denom;
+}
+
+
+/** Pseudo-remainder of polynomials a(x) and b(x) in Q[x].
+ *
+ *  @param a  first polynomial in x (dividend)
+ *  @param b  second polynomial in x (divisor)
+ *  @param x  a and b are polynomials in x
+ *  @param check_args  check whether a and b are polynomials with rational
+ *         coefficients (defaults to "true")
+ *  @return pseudo-remainder of a(x) and b(x) in Q[x] */
+ex prem(const ex &a, const ex &b, const ex &x, bool check_args)
+{
+       if (b.is_zero())
+               throw(std::overflow_error("prem: division by zero"));
+       if (is_exactly_a<numeric>(a)) {
+               if (is_exactly_a<numeric>(b))
+                       return _ex0;
+               else
+                       return b;
+       }
+       if (check_args && (!a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial)))
+               throw(std::invalid_argument("prem: arguments must be polynomials over the rationals"));
+
+       // Polynomial long division
+       ex r = a.expand();
+       ex eb = b.expand();
+       int rdeg = r.degree(x);
+       int bdeg = eb.degree(x);
+       ex blcoeff;
+       if (bdeg <= rdeg) {
+               blcoeff = eb.coeff(x, bdeg);
+               if (bdeg == 0)
+                       eb = _ex0;
+               else
+                       eb -= blcoeff * power(x, bdeg);
+       } else
+               blcoeff = _ex1;
+
+       int delta = rdeg - bdeg + 1, i = 0;
+       while (rdeg >= bdeg && !r.is_zero()) {
+               ex rlcoeff = r.coeff(x, rdeg);
+               ex term = (power(x, rdeg - bdeg) * eb * rlcoeff).expand();
+               if (rdeg == 0)
+                       r = _ex0;
+               else
+                       r -= rlcoeff * power(x, rdeg);
+               r = (blcoeff * r).expand() - term;
+               rdeg = r.degree(x);
+               i++;
+       }
+       return power(blcoeff, delta - i) * r;
+}
+
+
+/** Sparse pseudo-remainder of polynomials a(x) and b(x) in Q[x].
  *
  *  @param a  first polynomial in x (dividend)
  *  @param b  second polynomial in x (divisor)
  *  @param x  a and b are polynomials in x
  *  @param check_args  check whether a and b are polynomials with rational
  *         coefficients (defaults to "true")
- *  @return pseudo-remainder of a(x) and b(x) in Z[x] */
-
-ex prem(const ex &a, const ex &b, const symbol &x, bool check_args)
-{
-    if (b.is_zero())
-        throw(std::overflow_error("prem: division by zero"));
-    if (is_ex_exactly_of_type(a, numeric)) {
-        if (is_ex_exactly_of_type(b, numeric))
-            return exZERO();
-        else
-            return b;
-    }
-    if (check_args && (!a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial)))
-        throw(std::invalid_argument("prem: arguments must be polynomials over the rationals"));
-
-    // Polynomial long division
-    ex r = a.expand();
-    ex eb = b.expand();
-    int rdeg = r.degree(x);
-    int bdeg = eb.degree(x);
-    ex blcoeff;
-    if (bdeg <= rdeg) {
-        blcoeff = eb.coeff(x, bdeg);
-        if (bdeg == 0)
-            eb = exZERO();
-        else
-            eb -= blcoeff * power(x, bdeg);
-    } else
-        blcoeff = exONE();
-
-    int delta = rdeg - bdeg + 1, i = 0;
-    while (rdeg >= bdeg && !r.is_zero()) {
-        ex rlcoeff = r.coeff(x, rdeg);
-        ex term = (power(x, rdeg - bdeg) * eb * rlcoeff).expand();
-        if (rdeg == 0)
-            r = exZERO();
-        else
-            r -= rlcoeff * power(x, rdeg);
-        r = (blcoeff * r).expand() - term;
-        rdeg = r.degree(x);
-        i++;
-    }
-    return power(blcoeff, delta - i) * r;
+ *  @return sparse pseudo-remainder of a(x) and b(x) in Q[x] */
+ex sprem(const ex &a, const ex &b, const ex &x, bool check_args)
+{
+       if (b.is_zero())
+               throw(std::overflow_error("prem: division by zero"));
+       if (is_exactly_a<numeric>(a)) {
+               if (is_exactly_a<numeric>(b))
+                       return _ex0;
+               else
+                       return b;
+       }
+       if (check_args && (!a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial)))
+               throw(std::invalid_argument("prem: arguments must be polynomials over the rationals"));
+
+       // Polynomial long division
+       ex r = a.expand();
+       ex eb = b.expand();
+       int rdeg = r.degree(x);
+       int bdeg = eb.degree(x);
+       ex blcoeff;
+       if (bdeg <= rdeg) {
+               blcoeff = eb.coeff(x, bdeg);
+               if (bdeg == 0)
+                       eb = _ex0;
+               else
+                       eb -= blcoeff * power(x, bdeg);
+       } else
+               blcoeff = _ex1;
+
+       while (rdeg >= bdeg && !r.is_zero()) {
+               ex rlcoeff = r.coeff(x, rdeg);
+               ex term = (power(x, rdeg - bdeg) * eb * rlcoeff).expand();
+               if (rdeg == 0)
+                       r = _ex0;
+               else
+                       r -= rlcoeff * power(x, rdeg);
+               r = (blcoeff * r).expand() - term;
+               rdeg = r.degree(x);
+       }
+       return r;
 }
 
 
@@ -434,55 +586,63 @@ ex prem(const ex &a, const ex &b, const symbol &x, bool check_args)
  *  @param check_args  check whether a and b are polynomials with rational
  *         coefficients (defaults to "true")
  *  @return "true" when exact division succeeds (quotient returned in q),
- *          "false" otherwise */
-
+ *          "false" otherwise (q left untouched) */
 bool divide(const ex &a, const ex &b, ex &q, bool check_args)
 {
-    q = exZERO();
-    if (b.is_zero())
-        throw(std::overflow_error("divide: division by zero"));
-    if (is_ex_exactly_of_type(b, numeric)) {
-        q = a / b;
-        return true;
-    } else if (is_ex_exactly_of_type(a, numeric))
-        return false;
+       if (b.is_zero())
+               throw(std::overflow_error("divide: division by zero"));
+       if (a.is_zero()) {
+               q = _ex0;
+               return true;
+       }
+       if (is_exactly_a<numeric>(b)) {
+               q = a / b;
+               return true;
+       } else if (is_exactly_a<numeric>(a))
+               return false;
 #if FAST_COMPARE
-    if (a.is_equal(b)) {
-        q = exONE();
-        return true;
-    }
+       if (a.is_equal(b)) {
+               q = _ex1;
+               return true;
+       }
 #endif
-    if (check_args && (!a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial)))
-        throw(std::invalid_argument("divide: arguments must be polynomials over the rationals"));
-
-    // Find first symbol
-    const symbol *x;
-    if (!get_first_symbol(a, x) && !get_first_symbol(b, x))
-        throw(std::invalid_argument("invalid expression in divide()"));
-
-    // Polynomial long division (recursive)
-    ex r = a.expand();
-    if (r.is_zero())
-        return true;
-    int bdeg = b.degree(*x);
-    int rdeg = r.degree(*x);
-    ex blcoeff = b.expand().coeff(*x, bdeg);
-    bool blcoeff_is_numeric = is_ex_exactly_of_type(blcoeff, numeric);
-    while (rdeg >= bdeg) {
-        ex term, rcoeff = r.coeff(*x, rdeg);
-        if (blcoeff_is_numeric)
-            term = rcoeff / blcoeff;
-        else
-            if (!divide(rcoeff, blcoeff, term, false))
-                return false;
-        term *= power(*x, rdeg - bdeg);
-        q += term;
-        r -= (term * b).expand();
-        if (r.is_zero())
-            return true;
-        rdeg = r.degree(*x);
-    }
-    return false;
+       if (check_args && (!a.info(info_flags::rational_polynomial) ||
+                          !b.info(info_flags::rational_polynomial)))
+               throw(std::invalid_argument("divide: arguments must be polynomials over the rationals"));
+
+       // Find first symbol
+       ex x;
+       if (!get_first_symbol(a, x) && !get_first_symbol(b, x))
+               throw(std::invalid_argument("invalid expression in divide()"));
+
+       // Polynomial long division (recursive)
+       ex r = a.expand();
+       if (r.is_zero()) {
+               q = _ex0;
+               return true;
+       }
+       int bdeg = b.degree(x);
+       int rdeg = r.degree(x);
+       ex blcoeff = b.expand().coeff(x, bdeg);
+       bool blcoeff_is_numeric = is_exactly_a<numeric>(blcoeff);
+       exvector v; v.reserve(std::max(rdeg - bdeg + 1, 0));
+       while (rdeg >= bdeg) {
+               ex term, rcoeff = r.coeff(x, rdeg);
+               if (blcoeff_is_numeric)
+                       term = rcoeff / blcoeff;
+               else
+                       if (!divide(rcoeff, blcoeff, term, false))
+                               return false;
+               term *= power(x, rdeg - bdeg);
+               v.push_back(term);
+               r -= (term * b).expand();
+               if (r.is_zero()) {
+                       q = (new add(v))->setflag(status_flags::dynallocated);
+                       return true;
+               }
+               rdeg = r.degree(x);
+       }
+       return false;
 }
 
 
@@ -491,24 +651,25 @@ bool divide(const ex &a, const ex &b, ex &q, bool check_args)
  *  Remembering
  */
 
-typedef pair<ex, ex> ex2;
-typedef pair<ex, bool> exbool;
+typedef std::pair<ex, ex> ex2;
+typedef std::pair<ex, bool> exbool;
 
 struct ex2_less {
-    bool operator() (const ex2 p, const ex2 q) const 
-    {
-        return p.first.compare(q.first) < 0 || (!(q.first.compare(p.first) < 0) && p.second.compare(q.second) < 0);        
-    }
+       bool operator() (const ex2 &p, const ex2 &q) const 
+       {
+               int cmp = p.first.compare(q.first);
+               return ((cmp<0) || (!(cmp>0) && p.second.compare(q.second)<0));
+       }
 };
 
-typedef map<ex2, exbool, ex2_less> ex2_exbool_remember;
+typedef std::map<ex2, exbool, ex2_less> ex2_exbool_remember;
 #endif
 
 
 /** Exact polynomial division of a(X) by b(X) in Z[X].
  *  This functions works like divide() but the input and output polynomials are
  *  in Z[X] instead of Q[X] (i.e. they have integer coefficients). Unlike
- *  divide(), it doesn´t check whether the input polynomials really are integer
+ *  divide(), it doesn't check whether the input polynomials really are integer
  *  polynomials, so be careful of what you pass in. Also, you have to run
  *  get_symbol_stats() over the input polynomials before calling this function
  *  and pass an iterator to the first element of the sym_desc vector. This
@@ -523,127 +684,155 @@ typedef map<ex2, exbool, ex2_less> ex2_exbool_remember;
  *  @see get_symbol_stats, heur_gcd */
 static bool divide_in_z(const ex &a, const ex &b, ex &q, sym_desc_vec::const_iterator var)
 {
-    q = exZERO();
-    if (b.is_zero())
-        throw(std::overflow_error("divide_in_z: division by zero"));
-    if (b.is_equal(exONE())) {
-        q = a;
-        return true;
-    }
-    if (is_ex_exactly_of_type(a, numeric)) {
-        if (is_ex_exactly_of_type(b, numeric)) {
-            q = a / b;
-            return q.info(info_flags::integer);
-        } else
-            return false;
-    }
+       q = _ex0;
+       if (b.is_zero())
+               throw(std::overflow_error("divide_in_z: division by zero"));
+       if (b.is_equal(_ex1)) {
+               q = a;
+               return true;
+       }
+       if (is_exactly_a<numeric>(a)) {
+               if (is_exactly_a<numeric>(b)) {
+                       q = a / b;
+                       return q.info(info_flags::integer);
+               } else
+                       return false;
+       }
 #if FAST_COMPARE
-    if (a.is_equal(b)) {
-        q = exONE();
-        return true;
-    }
+       if (a.is_equal(b)) {
+               q = _ex1;
+               return true;
+       }
 #endif
 
 #if USE_REMEMBER
-    // Remembering
-    static ex2_exbool_remember dr_remember;
-    ex2_exbool_remember::const_iterator remembered = dr_remember.find(ex2(a, b));
-    if (remembered != dr_remember.end()) {
-        q = remembered->second.first;
-        return remembered->second.second;
-    }
+       // Remembering
+       static ex2_exbool_remember dr_remember;
+       ex2_exbool_remember::const_iterator remembered = dr_remember.find(ex2(a, b));
+       if (remembered != dr_remember.end()) {
+               q = remembered->second.first;
+               return remembered->second.second;
+       }
 #endif
 
-    // Main symbol
-    const symbol *x = var->sym;
-
-    // Compare degrees
-    int adeg = a.degree(*x), bdeg = b.degree(*x);
-    if (bdeg > adeg)
-        return false;
-
-#if 1
-
-    // Polynomial long division (recursive)
-    ex r = a.expand();
-    if (r.is_zero())
-        return true;
-    int rdeg = adeg;
-    ex eb = b.expand();
-    ex blcoeff = eb.coeff(*x, bdeg);
-    while (rdeg >= bdeg) {
-        ex term, rcoeff = r.coeff(*x, rdeg);
-        if (!divide_in_z(rcoeff, blcoeff, term, var+1))
-            break;
-        term = (term * power(*x, rdeg - bdeg)).expand();
-        q += term;
-        r -= (term * eb).expand();
-        if (r.is_zero()) {
+       if (is_exactly_a<power>(b)) {
+               const ex& bb(b.op(0));
+               ex qbar = a;
+               int exp_b = ex_to<numeric>(b.op(1)).to_int();
+               for (int i=exp_b; i>0; i--) {
+                       if (!divide_in_z(qbar, bb, q, var))
+                               return false;
+                       qbar = q;
+               }
+               return true;
+       }
+
+       if (is_exactly_a<mul>(b)) {
+               ex qbar = a;
+               for (const_iterator itrb = b.begin(); itrb != b.end(); ++itrb) {
+                       sym_desc_vec sym_stats;
+                       get_symbol_stats(a, *itrb, sym_stats);
+                       if (!divide_in_z(qbar, *itrb, q, sym_stats.begin()))
+                               return false;
+
+                       qbar = q;
+               }
+               return true;
+       }
+
+       // Main symbol
+       const ex &x = var->sym;
+
+       // Compare degrees
+       int adeg = a.degree(x), bdeg = b.degree(x);
+       if (bdeg > adeg)
+               return false;
+
+#if USE_TRIAL_DIVISION
+
+       // Trial division with polynomial interpolation
+       int i, k;
+
+       // Compute values at evaluation points 0..adeg
+       vector<numeric> alpha; alpha.reserve(adeg + 1);
+       exvector u; u.reserve(adeg + 1);
+       numeric point = *_num0_p;
+       ex c;
+       for (i=0; i<=adeg; i++) {
+               ex bs = b.subs(x == point, subs_options::no_pattern);
+               while (bs.is_zero()) {
+                       point += *_num1_p;
+                       bs = b.subs(x == point, subs_options::no_pattern);
+               }
+               if (!divide_in_z(a.subs(x == point, subs_options::no_pattern), bs, c, var+1))
+                       return false;
+               alpha.push_back(point);
+               u.push_back(c);
+               point += *_num1_p;
+       }
+
+       // Compute inverses
+       vector<numeric> rcp; rcp.reserve(adeg + 1);
+       rcp.push_back(*_num0_p);
+       for (k=1; k<=adeg; k++) {
+               numeric product = alpha[k] - alpha[0];
+               for (i=1; i<k; i++)
+                       product *= alpha[k] - alpha[i];
+               rcp.push_back(product.inverse());
+       }
+
+       // Compute Newton coefficients
+       exvector v; v.reserve(adeg + 1);
+       v.push_back(u[0]);
+       for (k=1; k<=adeg; k++) {
+               ex temp = v[k - 1];
+               for (i=k-2; i>=0; i--)
+                       temp = temp * (alpha[k] - alpha[i]) + v[i];
+               v.push_back((u[k] - temp) * rcp[k]);
+       }
+
+       // Convert from Newton form to standard form
+       c = v[adeg];
+       for (k=adeg-1; k>=0; k--)
+               c = c * (x - alpha[k]) + v[k];
+
+       if (c.degree(x) == (adeg - bdeg)) {
+               q = c.expand();
+               return true;
+       } else
+               return false;
+
+#else
+
+       // Polynomial long division (recursive)
+       ex r = a.expand();
+       if (r.is_zero())
+               return true;
+       int rdeg = adeg;
+       ex eb = b.expand();
+       ex blcoeff = eb.coeff(x, bdeg);
+       exvector v; v.reserve(std::max(rdeg - bdeg + 1, 0));
+       while (rdeg >= bdeg) {
+               ex term, rcoeff = r.coeff(x, rdeg);
+               if (!divide_in_z(rcoeff, blcoeff, term, var+1))
+                       break;
+               term = (term * power(x, rdeg - bdeg)).expand();
+               v.push_back(term);
+               r -= (term * eb).expand();
+               if (r.is_zero()) {
+                       q = (new add(v))->setflag(status_flags::dynallocated);
 #if USE_REMEMBER
-            dr_remember[ex2(a, b)] = exbool(q, true);
+                       dr_remember[ex2(a, b)] = exbool(q, true);
 #endif
-            return true;
-        }
-        rdeg = r.degree(*x);
-    }
+                       return true;
+               }
+               rdeg = r.degree(x);
+       }
 #if USE_REMEMBER
-    dr_remember[ex2(a, b)] = exbool(q, false);
+       dr_remember[ex2(a, b)] = exbool(q, false);
 #endif
-    return false;
+       return false;
 
-#else
-
-    // Trial division using polynomial interpolation
-    int i, k;
-
-    // Compute values at evaluation points 0..adeg
-    vector<numeric> alpha; alpha.reserve(adeg + 1);
-    exvector u; u.reserve(adeg + 1);
-    numeric point = numZERO();
-    ex c;
-    for (i=0; i<=adeg; i++) {
-        ex bs = b.subs(*x == point);
-        while (bs.is_zero()) {
-            point += numONE();
-            bs = b.subs(*x == point);
-        }
-        if (!divide_in_z(a.subs(*x == point), bs, c, var+1))
-            return false;
-        alpha.push_back(point);
-        u.push_back(c);
-        point += numONE();
-    }
-
-    // Compute inverses
-    vector<numeric> rcp; rcp.reserve(adeg + 1);
-    rcp.push_back(0);
-    for (k=1; k<=adeg; k++) {
-        numeric product = alpha[k] - alpha[0];
-        for (i=1; i<k; i++)
-            product *= alpha[k] - alpha[i];
-        rcp.push_back(product.inverse());
-    }
-
-    // Compute Newton coefficients
-    exvector v; v.reserve(adeg + 1);
-    v.push_back(u[0]);
-    for (k=1; k<=adeg; k++) {
-        ex temp = v[k - 1];
-        for (i=k-2; i>=0; i--)
-            temp = temp * (alpha[k] - alpha[i]) + v[i];
-        v.push_back((u[k] - temp) * rcp[k]);
-    }
-
-    // Convert from Newton form to standard form
-    c = v[adeg];
-    for (k=adeg-1; k>=0; k--)
-        c = c * (*x - alpha[k]) + v[k];
-
-    if (c.degree(*x) == (adeg - bdeg)) {
-        q = c.expand();
-        return true;
-    } else
-        return false;
 #endif
 }
 
@@ -653,110 +842,154 @@ static bool divide_in_z(const ex &a, const ex &b, ex &q, sym_desc_vec::const_ite
  */
 
 /** Compute unit part (= sign of leading coefficient) of a multivariate
- *  polynomial in Z[x]. The product of unit part, content part, and primitive
+ *  polynomial in Q[x]. The product of unit part, content part, and primitive
  *  part is the polynomial itself.
  *
- *  @param x  variable in which to compute the unit part
+ *  @param x  main variable
  *  @return unit part
- *  @see ex::content, ex::primpart */
-ex ex::unit(const symbol &x) const
+ *  @see ex::content, ex::primpart, ex::unitcontprim */
+ex ex::unit(const ex &x) const
 {
-    ex c = expand().lcoeff(x);
-    if (is_ex_exactly_of_type(c, numeric))
-        return c < exZERO() ? exMINUSONE() : exONE();
-    else {
-        const symbol *y;
-        if (get_first_symbol(c, y))
-            return c.unit(*y);
-        else
-            throw(std::invalid_argument("invalid expression in unit()"));
-    }
+       ex c = expand().lcoeff(x);
+       if (is_exactly_a<numeric>(c))
+               return c.info(info_flags::negative) ?_ex_1 : _ex1;
+       else {
+               ex y;
+               if (get_first_symbol(c, y))
+                       return c.unit(y);
+               else
+                       throw(std::invalid_argument("invalid expression in unit()"));
+       }
 }
 
 
 /** Compute content part (= unit normal GCD of all coefficients) of a
- *  multivariate polynomial in Z[x].  The product of unit part, content part,
+ *  multivariate polynomial in Q[x]. The product of unit part, content part,
  *  and primitive part is the polynomial itself.
  *
- *  @param x  variable in which to compute the content part
+ *  @param x  main variable
  *  @return content part
- *  @see ex::unit, ex::primpart */
-ex ex::content(const symbol &x) const
-{
-    if (is_zero())
-        return exZERO();
-    if (is_ex_exactly_of_type(*this, numeric))
-        return info(info_flags::negative) ? -*this : *this;
-    ex e = expand();
-    if (e.is_zero())
-        return exZERO();
-
-    // First, try the integer content
-    ex c = e.integer_content();
-    ex r = e / c;
-    ex lcoeff = r.lcoeff(x);
-    if (lcoeff.info(info_flags::integer))
-        return c;
-
-    // GCD of all coefficients
-    int deg = e.degree(x);
-    int ldeg = e.ldegree(x);
-    if (deg == ldeg)
-        return e.lcoeff(x) / e.unit(x);
-    c = exZERO();
-    for (int i=ldeg; i<=deg; i++)
-        c = gcd(e.coeff(x, i), c, NULL, NULL, false);
-    return c;
-}
-
-
-/** Compute primitive part of a multivariate polynomial in Z[x].
- *  The product of unit part, content part, and primitive part is the
- *  polynomial itself.
+ *  @see ex::unit, ex::primpart, ex::unitcontprim */
+ex ex::content(const ex &x) const
+{
+       if (is_exactly_a<numeric>(*this))
+               return info(info_flags::negative) ? -*this : *this;
+
+       ex e = expand();
+       if (e.is_zero())
+               return _ex0;
+
+       // First, divide out the integer content (which we can calculate very efficiently).
+       // If the leading coefficient of the quotient is an integer, we are done.
+       ex c = e.integer_content();
+       ex r = e / c;
+       int deg = r.degree(x);
+       ex lcoeff = r.coeff(x, deg);
+       if (lcoeff.info(info_flags::integer))
+               return c;
+
+       // GCD of all coefficients
+       int ldeg = r.ldegree(x);
+       if (deg == ldeg)
+               return lcoeff * c / lcoeff.unit(x);
+       ex cont = _ex0;
+       for (int i=ldeg; i<=deg; i++)
+               cont = gcd(r.coeff(x, i), cont, NULL, NULL, false);
+       return cont * c;
+}
+
+
+/** Compute primitive part of a multivariate polynomial in Q[x]. The result
+ *  will be a unit-normal polynomial with a content part of 1. The product
+ *  of unit part, content part, and primitive part is the polynomial itself.
  *
- *  @param x  variable in which to compute the primitive part
+ *  @param x  main variable
  *  @return primitive part
- *  @see ex::unit, ex::content */
-ex ex::primpart(const symbol &x) const
+ *  @see ex::unit, ex::content, ex::unitcontprim */
+ex ex::primpart(const ex &x) const
 {
-    if (is_zero())
-        return exZERO();
-    if (is_ex_exactly_of_type(*this, numeric))
-        return exONE();
-
-    ex c = content(x);
-    if (c.is_zero())
-        return exZERO();
-    ex u = unit(x);
-    if (is_ex_exactly_of_type(c, numeric))
-        return *this / (c * u);
-    else
-        return quo(*this, c * u, x, false);
+       // We need to compute the unit and content anyway, so call unitcontprim()
+       ex u, c, p;
+       unitcontprim(x, u, c, p);
+       return p;
 }
 
 
-/** Compute primitive part of a multivariate polynomial in Z[x] when the
+/** Compute primitive part of a multivariate polynomial in Q[x] when the
  *  content part is already known. This function is faster in computing the
  *  primitive part than the previous function.
  *
- *  @param x  variable in which to compute the primitive part
+ *  @param x  main variable
  *  @param c  previously computed content part
  *  @return primitive part */
+ex ex::primpart(const ex &x, const ex &c) const
+{
+       if (is_zero() || c.is_zero())
+               return _ex0;
+       if (is_exactly_a<numeric>(*this))
+               return _ex1;
+
+       // Divide by unit and content to get primitive part
+       ex u = unit(x);
+       if (is_exactly_a<numeric>(c))
+               return *this / (c * u);
+       else
+               return quo(*this, c * u, x, false);
+}
+
 
-ex ex::primpart(const symbol &x, const ex &c) const
+/** Compute unit part, content part, and primitive part of a multivariate
+ *  polynomial in Q[x]. The product of the three parts is the polynomial
+ *  itself.
+ *
+ *  @param x  main variable
+ *  @param u  unit part (returned)
+ *  @param c  content part (returned)
+ *  @param p  primitive part (returned)
+ *  @see ex::unit, ex::content, ex::primpart */
+void ex::unitcontprim(const ex &x, ex &u, ex &c, ex &p) const
 {
-    if (is_zero())
-        return exZERO();
-    if (c.is_zero())
-        return exZERO();
-    if (is_ex_exactly_of_type(*this, numeric))
-        return exONE();
+       // Quick check for zero (avoid expanding)
+       if (is_zero()) {
+               u = _ex1;
+               c = p = _ex0;
+               return;
+       }
+
+       // Special case: input is a number
+       if (is_exactly_a<numeric>(*this)) {
+               if (info(info_flags::negative)) {
+                       u = _ex_1;
+                       c = abs(ex_to<numeric>(*this));
+               } else {
+                       u = _ex1;
+                       c = *this;
+               }
+               p = _ex1;
+               return;
+       }
+
+       // Expand input polynomial
+       ex e = expand();
+       if (e.is_zero()) {
+               u = _ex1;
+               c = p = _ex0;
+               return;
+       }
+
+       // Compute unit and content
+       u = unit(x);
+       c = content(x);
 
-    ex u = unit(x);
-    if (is_ex_exactly_of_type(c, numeric))
-        return *this / (c * u);
-    else
-        return quo(*this, c * u, x, false);
+       // Divide by unit and content to get primitive part
+       if (c.is_zero()) {
+               p = _ex0;
+               return;
+       }
+       if (is_exactly_a<numeric>(c))
+               p = *this / (c * u);
+       else
+               p = quo(e, c * u, x, false);
 }
 
 
@@ -765,190 +998,204 @@ ex ex::primpart(const symbol &x, const ex &c) const
  */
 
 /** Compute GCD of multivariate polynomials using the subresultant PRS
- *  algorithm. This function is used internally gy gcd().
+ *  algorithm. This function is used internally by gcd().
  *
- *  @param a  first multivariate polynomial
- *  @param b  second multivariate polynomial
- *  @param x  pointer to symbol (main variable) in which to compute the GCD in
+ *  @param a   first multivariate polynomial
+ *  @param b   second multivariate polynomial
+ *  @param var iterator to first element of vector of sym_desc structs
  *  @return the GCD as a new expression
  *  @see gcd */
 
-static ex sr_gcd(const ex &a, const ex &b, const symbol *x)
-{
-    // Sort c and d so that c has higher degree
-    ex c, d;
-    int adeg = a.degree(*x), bdeg = b.degree(*x);
-    int cdeg, ddeg;
-    if (adeg >= bdeg) {
-        c = a;
-        d = b;
-        cdeg = adeg;
-        ddeg = bdeg;
-    } else {
-        c = b;
-        d = a;
-        cdeg = bdeg;
-        ddeg = adeg;
-    }
-
-    // Remove content from c and d, to be attached to GCD later
-    ex cont_c = c.content(*x);
-    ex cont_d = d.content(*x);
-    ex gamma = gcd(cont_c, cont_d, NULL, NULL, false);
-    if (ddeg == 0)
-        return gamma;
-    c = c.primpart(*x, cont_c);
-    d = d.primpart(*x, cont_d);
-
-    // First element of subresultant sequence
-    ex r = exZERO(), ri = exONE(), psi = exONE();
-    int delta = cdeg - ddeg;
-
-    for (;;) {
-        // Calculate polynomial pseudo-remainder
-        r = prem(c, d, *x, false);
-        if (r.is_zero())
-            return gamma * d.primpart(*x);
-        c = d;
-        cdeg = ddeg;
-        if (!divide(r, ri * power(psi, delta), d, false))
-            throw(std::runtime_error("invalid expression in sr_gcd(), division failed"));
-        ddeg = d.degree(*x);
-        if (ddeg == 0) {
-            if (is_ex_exactly_of_type(r, numeric))
-                return gamma;
-            else
-                return gamma * r.primpart(*x);
-        }
-
-        // Next element of subresultant sequence
-        ri = c.expand().lcoeff(*x);
-        if (delta == 1)
-            psi = ri;
-        else if (delta)
-            divide(power(ri, delta), power(psi, delta-1), psi, false);
-        delta = cdeg - ddeg;
-    }
+static ex sr_gcd(const ex &a, const ex &b, sym_desc_vec::const_iterator var)
+{
+#if STATISTICS
+       sr_gcd_called++;
+#endif
+
+       // The first symbol is our main variable
+       const ex &x = var->sym;
+
+       // Sort c and d so that c has higher degree
+       ex c, d;
+       int adeg = a.degree(x), bdeg = b.degree(x);
+       int cdeg, ddeg;
+       if (adeg >= bdeg) {
+               c = a;
+               d = b;
+               cdeg = adeg;
+               ddeg = bdeg;
+       } else {
+               c = b;
+               d = a;
+               cdeg = bdeg;
+               ddeg = adeg;
+       }
+
+       // Remove content from c and d, to be attached to GCD later
+       ex cont_c = c.content(x);
+       ex cont_d = d.content(x);
+       ex gamma = gcd(cont_c, cont_d, NULL, NULL, false);
+       if (ddeg == 0)
+               return gamma;
+       c = c.primpart(x, cont_c);
+       d = d.primpart(x, cont_d);
+
+       // First element of subresultant sequence
+       ex r = _ex0, ri = _ex1, psi = _ex1;
+       int delta = cdeg - ddeg;
+
+       for (;;) {
+
+               // Calculate polynomial pseudo-remainder
+               r = prem(c, d, x, false);
+               if (r.is_zero())
+                       return gamma * d.primpart(x);
+
+               c = d;
+               cdeg = ddeg;
+               if (!divide_in_z(r, ri * pow(psi, delta), d, var))
+                       throw(std::runtime_error("invalid expression in sr_gcd(), division failed"));
+               ddeg = d.degree(x);
+               if (ddeg == 0) {
+                       if (is_exactly_a<numeric>(r))
+                               return gamma;
+                       else
+                               return gamma * r.primpart(x);
+               }
+
+               // Next element of subresultant sequence
+               ri = c.expand().lcoeff(x);
+               if (delta == 1)
+                       psi = ri;
+               else if (delta)
+                       divide_in_z(pow(ri, delta), pow(psi, delta-1), psi, var+1);
+               delta = cdeg - ddeg;
+       }
 }
 
 
 /** Return maximum (absolute value) coefficient of a polynomial.
  *  This function is used internally by heur_gcd().
  *
- *  @param e  expanded multivariate polynomial
  *  @return maximum coefficient
  *  @see heur_gcd */
-
-numeric ex::max_coefficient(void) const
+numeric ex::max_coefficient() const
 {
-    GINAC_ASSERT(bp!=0);
-    return bp->max_coefficient();
+       return bp->max_coefficient();
 }
 
-numeric basic::max_coefficient(void) const
+/** Implementation ex::max_coefficient().
+ *  @see heur_gcd */
+numeric basic::max_coefficient() const
 {
-    return numONE();
+       return *_num1_p;
 }
 
-numeric numeric::max_coefficient(void) const
+numeric numeric::max_coefficient() const
 {
-    return abs(*this);
+       return abs(*this);
 }
 
-numeric add::max_coefficient(void) const
+numeric add::max_coefficient() const
 {
-    epvector::const_iterator it = seq.begin();
-    epvector::const_iterator itend = seq.end();
-    GINAC_ASSERT(is_ex_exactly_of_type(overall_coeff,numeric));
-    numeric cur_max = abs(ex_to_numeric(overall_coeff));
-    while (it != itend) {
-        numeric a;
-        GINAC_ASSERT(!is_ex_exactly_of_type(it->rest,numeric));
-        a = abs(ex_to_numeric(it->coeff));
-        if (a > cur_max)
-            cur_max = a;
-        it++;
-    }
-    return cur_max;
+       epvector::const_iterator it = seq.begin();
+       epvector::const_iterator itend = seq.end();
+       GINAC_ASSERT(is_exactly_a<numeric>(overall_coeff));
+       numeric cur_max = abs(ex_to<numeric>(overall_coeff));
+       while (it != itend) {
+               numeric a;
+               GINAC_ASSERT(!is_exactly_a<numeric>(it->rest));
+               a = abs(ex_to<numeric>(it->coeff));
+               if (a > cur_max)
+                       cur_max = a;
+               it++;
+       }
+       return cur_max;
 }
 
-numeric mul::max_coefficient(void) const
+numeric mul::max_coefficient() const
 {
 #ifdef DO_GINAC_ASSERT
-    epvector::const_iterator it = seq.begin();
-    epvector::const_iterator itend = seq.end();
-    while (it != itend) {
-        GINAC_ASSERT(!is_ex_exactly_of_type(recombine_pair_to_ex(*it),numeric));
-        it++;
-    }
+       epvector::const_iterator it = seq.begin();
+       epvector::const_iterator itend = seq.end();
+       while (it != itend) {
+               GINAC_ASSERT(!is_exactly_a<numeric>(recombine_pair_to_ex(*it)));
+               it++;
+       }
 #endif // def DO_GINAC_ASSERT
-    GINAC_ASSERT(is_ex_exactly_of_type(overall_coeff,numeric));
-    return abs(ex_to_numeric(overall_coeff));
+       GINAC_ASSERT(is_exactly_a<numeric>(overall_coeff));
+       return abs(ex_to<numeric>(overall_coeff));
 }
 
 
-/** Apply symmetric modular homomorphism to a multivariate polynomial.
- *  This function is used internally by heur_gcd().
+/** Apply symmetric modular homomorphism to an expanded multivariate
+ *  polynomial.  This function is usually used internally by heur_gcd().
  *
- *  @param e  expanded multivariate polynomial
  *  @param xi  modulus
  *  @return mapped polynomial
  *  @see heur_gcd */
-
-ex ex::smod(const numeric &xi) const
-{
-    GINAC_ASSERT(bp!=0);
-    return bp->smod(xi);
-}
-
 ex basic::smod(const numeric &xi) const
 {
-    return *this;
+       return *this;
 }
 
 ex numeric::smod(const numeric &xi) const
 {
-    return GiNaC::smod(*this, xi);
+       return GiNaC::smod(*this, xi);
 }
 
 ex add::smod(const numeric &xi) const
 {
-    epvector newseq;
-    newseq.reserve(seq.size()+1);
-    epvector::const_iterator it = seq.begin();
-    epvector::const_iterator itend = seq.end();
-    while (it != itend) {
-        GINAC_ASSERT(!is_ex_exactly_of_type(it->rest,numeric));
-        numeric coeff = GiNaC::smod(ex_to_numeric(it->coeff), xi);
-        if (!coeff.is_zero())
-            newseq.push_back(expair(it->rest, coeff));
-        it++;
-    }
-    GINAC_ASSERT(is_ex_exactly_of_type(overall_coeff,numeric));
-    numeric coeff = GiNaC::smod(ex_to_numeric(overall_coeff), xi);
-    return (new add(newseq,coeff))->setflag(status_flags::dynallocated);
+       epvector newseq;
+       newseq.reserve(seq.size()+1);
+       epvector::const_iterator it = seq.begin();
+       epvector::const_iterator itend = seq.end();
+       while (it != itend) {
+               GINAC_ASSERT(!is_exactly_a<numeric>(it->rest));
+               numeric coeff = GiNaC::smod(ex_to<numeric>(it->coeff), xi);
+               if (!coeff.is_zero())
+                       newseq.push_back(expair(it->rest, coeff));
+               it++;
+       }
+       GINAC_ASSERT(is_exactly_a<numeric>(overall_coeff));
+       numeric coeff = GiNaC::smod(ex_to<numeric>(overall_coeff), xi);
+       return (new add(newseq,coeff))->setflag(status_flags::dynallocated);
 }
 
 ex mul::smod(const numeric &xi) const
 {
 #ifdef DO_GINAC_ASSERT
-    epvector::const_iterator it = seq.begin();
-    epvector::const_iterator itend = seq.end();
-    while (it != itend) {
-        GINAC_ASSERT(!is_ex_exactly_of_type(recombine_pair_to_ex(*it),numeric));
-        it++;
-    }
+       epvector::const_iterator it = seq.begin();
+       epvector::const_iterator itend = seq.end();
+       while (it != itend) {
+               GINAC_ASSERT(!is_exactly_a<numeric>(recombine_pair_to_ex(*it)));
+               it++;
+       }
 #endif // def DO_GINAC_ASSERT
-    mul * mulcopyp=new mul(*this);
-    GINAC_ASSERT(is_ex_exactly_of_type(overall_coeff,numeric));
-    mulcopyp->overall_coeff = GiNaC::smod(ex_to_numeric(overall_coeff),xi);
-    mulcopyp->clearflag(status_flags::evaluated);
-    mulcopyp->clearflag(status_flags::hash_calculated);
-    return mulcopyp->setflag(status_flags::dynallocated);
+       mul * mulcopyp = new mul(*this);
+       GINAC_ASSERT(is_exactly_a<numeric>(overall_coeff));
+       mulcopyp->overall_coeff = GiNaC::smod(ex_to<numeric>(overall_coeff),xi);
+       mulcopyp->clearflag(status_flags::evaluated);
+       mulcopyp->clearflag(status_flags::hash_calculated);
+       return mulcopyp->setflag(status_flags::dynallocated);
 }
 
 
-/** Exception thrown by heur_gcd() to signal failure */
+/** xi-adic polynomial interpolation */
+static ex interpolate(const ex &gamma, const numeric &xi, const ex &x, int degree_hint = 1)
+{
+       exvector g; g.reserve(degree_hint);
+       ex e = gamma;
+       numeric rxi = xi.inverse();
+       for (int i=0; !e.is_zero(); i++) {
+               ex gi = e.smod(xi);
+               g.push_back(gi * power(x, i));
+               e = (e - gi) * rxi;
+       }
+       return (new add(g))->setflag(status_flags::dynallocated);
+}
+
+/** Exception thrown by heur_gcd() to signal failure. */
 class gcdheu_failed {};
 
 /** Compute GCD of multivariate polynomials using the heuristic GCD algorithm.
@@ -966,184 +1213,386 @@ class gcdheu_failed {};
  *  @return the GCD as a new expression
  *  @see gcd
  *  @exception gcdheu_failed() */
-
 static ex heur_gcd(const ex &a, const ex &b, ex *ca, ex *cb, sym_desc_vec::const_iterator var)
 {
-    if (is_ex_exactly_of_type(a, numeric) && is_ex_exactly_of_type(b, numeric)) {
-        numeric g = gcd(ex_to_numeric(a), ex_to_numeric(b));
-        numeric rg;
-        if (ca || cb)
-            rg = g.inverse();
-        if (ca)
-            *ca = ex_to_numeric(a).mul(rg);
-        if (cb)
-            *cb = ex_to_numeric(b).mul(rg);
-        return g;
-    }
-
-    // The first symbol is our main variable
-    const symbol *x = var->sym;
-
-    // Remove integer content
-    numeric gc = gcd(a.integer_content(), b.integer_content());
-    numeric rgc = gc.inverse();
-    ex p = a * rgc;
-    ex q = b * rgc;
-    int maxdeg = max(p.degree(*x), q.degree(*x));
-
-    // Find evaluation point
-    numeric mp = p.max_coefficient(), mq = q.max_coefficient();
-    numeric xi;
-    if (mp > mq)
-        xi = mq * numTWO() + numTWO();
-    else
-        xi = mp * numTWO() + numTWO();
-
-    // 6 tries maximum
-    for (int t=0; t<6; t++) {
-        if (xi.int_length() * maxdeg > 50000)
-            throw gcdheu_failed();
-
-        // Apply evaluation homomorphism and calculate GCD
-        ex gamma = heur_gcd(p.subs(*x == xi), q.subs(*x == xi), NULL, NULL, var+1).expand();
-        if (!is_ex_exactly_of_type(gamma, fail)) {
-
-            // Reconstruct polynomial from GCD of mapped polynomials
-            ex g = exZERO();
-            numeric rxi = xi.inverse();
-            for (int i=0; !gamma.is_zero(); i++) {
-                ex gi = gamma.smod(xi);
-                g += gi * power(*x, i);
-                gamma = (gamma - gi) * rxi;
-            }
-            // Remove integer content
-            g /= g.integer_content();
-
-            // If the calculated polynomial divides both a and b, this is the GCD
-            ex dummy;
-            if (divide_in_z(p, g, ca ? *ca : dummy, var) && divide_in_z(q, g, cb ? *cb : dummy, var)) {
-                g *= gc;
-                ex lc = g.lcoeff(*x);
-                if (is_ex_exactly_of_type(lc, numeric) && lc.compare(exZERO()) < 0)
-                    return -g;
-                else
-                    return g;
-            }
-        }
-
-        // Next evaluation point
-        xi = iquo(xi * isqrt(isqrt(xi)) * numeric(73794), numeric(27011));
-    }
-    return *new ex(fail());
+#if STATISTICS
+       heur_gcd_called++;
+#endif
+
+       // Algorithm only works for non-vanishing input polynomials
+       if (a.is_zero() || b.is_zero())
+               return (new fail())->setflag(status_flags::dynallocated);
+
+       // GCD of two numeric values -> CLN
+       if (is_exactly_a<numeric>(a) && is_exactly_a<numeric>(b)) {
+               numeric g = gcd(ex_to<numeric>(a), ex_to<numeric>(b));
+               if (ca)
+                       *ca = ex_to<numeric>(a) / g;
+               if (cb)
+                       *cb = ex_to<numeric>(b) / g;
+               return g;
+       }
+
+       // The first symbol is our main variable
+       const ex &x = var->sym;
+
+       // Remove integer content
+       numeric gc = gcd(a.integer_content(), b.integer_content());
+       numeric rgc = gc.inverse();
+       ex p = a * rgc;
+       ex q = b * rgc;
+       int maxdeg =  std::max(p.degree(x), q.degree(x));
+       
+       // Find evaluation point
+       numeric mp = p.max_coefficient();
+       numeric mq = q.max_coefficient();
+       numeric xi;
+       if (mp > mq)
+               xi = mq * (*_num2_p) + (*_num2_p);
+       else
+               xi = mp * (*_num2_p) + (*_num2_p);
+
+       // 6 tries maximum
+       for (int t=0; t<6; t++) {
+               if (xi.int_length() * maxdeg > 100000) {
+                       throw gcdheu_failed();
+               }
+
+               // Apply evaluation homomorphism and calculate GCD
+               ex cp, cq;
+               ex gamma = heur_gcd(p.subs(x == xi, subs_options::no_pattern), q.subs(x == xi, subs_options::no_pattern), &cp, &cq, var+1).expand();
+               if (!is_exactly_a<fail>(gamma)) {
+
+                       // Reconstruct polynomial from GCD of mapped polynomials
+                       ex g = interpolate(gamma, xi, x, maxdeg);
+
+                       // Remove integer content
+                       g /= g.integer_content();
+
+                       // If the calculated polynomial divides both p and q, this is the GCD
+                       ex dummy;
+                       if (divide_in_z(p, g, ca ? *ca : dummy, var) && divide_in_z(q, g, cb ? *cb : dummy, var)) {
+                               g *= gc;
+                               return g;
+                       }
+               }
+
+               // Next evaluation point
+               xi = iquo(xi * isqrt(isqrt(xi)) * numeric(73794), numeric(27011));
+       }
+       return (new fail())->setflag(status_flags::dynallocated);
 }
 
 
 /** Compute GCD (Greatest Common Divisor) of multivariate polynomials a(X)
- *  and b(X) in Z[X].
+ *  and b(X) in Z[X]. Optionally also compute the cofactors of a and b,
+ *  defined by a = ca * gcd(a, b) and b = cb * gcd(a, b).
  *
  *  @param a  first multivariate polynomial
  *  @param b  second multivariate polynomial
+ *  @param ca pointer to expression that will receive the cofactor of a, or NULL
+ *  @param cb pointer to expression that will receive the cofactor of b, or NULL
  *  @param check_args  check whether a and b are polynomials with rational
  *         coefficients (defaults to "true")
  *  @return the GCD as a new expression */
-
 ex gcd(const ex &a, const ex &b, ex *ca, ex *cb, bool check_args)
 {
-    // Some trivial cases
+#if STATISTICS
+       gcd_called++;
+#endif
+
+       // GCD of numerics -> CLN
+       if (is_exactly_a<numeric>(a) && is_exactly_a<numeric>(b)) {
+               numeric g = gcd(ex_to<numeric>(a), ex_to<numeric>(b));
+               if (ca || cb) {
+                       if (g.is_zero()) {
+                               if (ca)
+                                       *ca = _ex0;
+                               if (cb)
+                                       *cb = _ex0;
+                       } else {
+                               if (ca)
+                                       *ca = ex_to<numeric>(a) / g;
+                               if (cb)
+                                       *cb = ex_to<numeric>(b) / g;
+                       }
+               }
+               return g;
+       }
+
+       // Check arguments
+       if (check_args && (!a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial))) {
+               throw(std::invalid_argument("gcd: arguments must be polynomials over the rationals"));
+       }
+
+       // Partially factored cases (to avoid expanding large expressions)
+       if (is_exactly_a<mul>(a)) {
+               if (is_exactly_a<mul>(b) && b.nops() > a.nops())
+                       goto factored_b;
+factored_a:
+               size_t num = a.nops();
+               exvector g; g.reserve(num);
+               exvector acc_ca; acc_ca.reserve(num);
+               ex part_b = b;
+               for (size_t i=0; i<num; i++) {
+                       ex part_ca, part_cb;
+                       g.push_back(gcd(a.op(i), part_b, &part_ca, &part_cb, check_args));
+                       acc_ca.push_back(part_ca);
+                       part_b = part_cb;
+               }
+               if (ca)
+                       *ca = (new mul(acc_ca))->setflag(status_flags::dynallocated);
+               if (cb)
+                       *cb = part_b;
+               return (new mul(g))->setflag(status_flags::dynallocated);
+       } else if (is_exactly_a<mul>(b)) {
+               if (is_exactly_a<mul>(a) && a.nops() > b.nops())
+                       goto factored_a;
+factored_b:
+               size_t num = b.nops();
+               exvector g; g.reserve(num);
+               exvector acc_cb; acc_cb.reserve(num);
+               ex part_a = a;
+               for (size_t i=0; i<num; i++) {
+                       ex part_ca, part_cb;
+                       g.push_back(gcd(part_a, b.op(i), &part_ca, &part_cb, check_args));
+                       acc_cb.push_back(part_cb);
+                       part_a = part_ca;
+               }
+               if (ca)
+                       *ca = part_a;
+               if (cb)
+                       *cb = (new mul(acc_cb))->setflag(status_flags::dynallocated);
+               return (new mul(g))->setflag(status_flags::dynallocated);
+       }
+
+#if FAST_COMPARE
+       // Input polynomials of the form poly^n are sometimes also trivial
+       if (is_exactly_a<power>(a)) {
+               ex p = a.op(0);
+               const ex& exp_a = a.op(1);
+               if (is_exactly_a<power>(b)) {
+                       ex pb = b.op(0);
+                       const ex& exp_b = b.op(1);
+                       if (p.is_equal(pb)) {
+                               // a = p^n, b = p^m, gcd = p^min(n, m)
+                               if (exp_a < exp_b) {
+                                       if (ca)
+                                               *ca = _ex1;
+                                       if (cb)
+                                               *cb = power(p, exp_b - exp_a);
+                                       return power(p, exp_a);
+                               } else {
+                                       if (ca)
+                                               *ca = power(p, exp_a - exp_b);
+                                       if (cb)
+                                               *cb = _ex1;
+                                       return power(p, exp_b);
+                               }
+                       } else {
+                               ex p_co, pb_co;
+                               ex p_gcd = gcd(p, pb, &p_co, &pb_co, check_args);
+                               if (p_gcd.is_equal(_ex1)) {
+                                       // a(x) = p(x)^n, b(x) = p_b(x)^m, gcd (p, p_b) = 1 ==>
+                                       // gcd(a,b) = 1
+                                       if (ca)
+                                               *ca = a;
+                                       if (cb)
+                                               *cb = b;
+                                       return _ex1;
+                                       // XXX: do I need to check for p_gcd = -1?
+                               } else {
+                                       // there are common factors:
+                                       // a(x) = g(x)^n A(x)^n, b(x) = g(x)^m B(x)^m ==>
+                                       // gcd(a, b) = g(x)^n gcd(A(x)^n, g(x)^(n-m) B(x)^m
+                                       if (exp_a < exp_b) {
+                                               return power(p_gcd, exp_a)*
+                                                       gcd(power(p_co, exp_a), power(p_gcd, exp_b-exp_a)*power(pb_co, exp_b), ca, cb, false);
+                                       } else {
+                                               return power(p_gcd, exp_b)*
+                                                       gcd(power(p_gcd, exp_a - exp_b)*power(p_co, exp_a), power(pb_co, exp_b), ca, cb, false);
+                                       }
+                               } // p_gcd.is_equal(_ex1)
+                       } // p.is_equal(pb)
+
+               } else {
+                       if (p.is_equal(b)) {
+                               // a = p^n, b = p, gcd = p
+                               if (ca)
+                                       *ca = power(p, a.op(1) - 1);
+                               if (cb)
+                                       *cb = _ex1;
+                               return p;
+                       } 
+
+                       ex p_co, bpart_co;
+                       ex p_gcd = gcd(p, b, &p_co, &bpart_co, false);
+
+                       if (p_gcd.is_equal(_ex1)) {
+                               // a(x) = p(x)^n, gcd(p, b) = 1 ==> gcd(a, b) = 1
+                               if (ca)
+                                       *ca = a;
+                               if (cb)
+                                       *cb = b;
+                               return _ex1;
+                       } else {
+                               // a(x) = g(x)^n A(x)^n, b(x) = g(x) B(x) ==> gcd(a, b) = g(x) gcd(g(x)^(n-1) A(x)^n, B(x))
+                               return p_gcd*gcd(power(p_gcd, exp_a-1)*power(p_co, exp_a), bpart_co, ca, cb, false);
+                       }
+               } // is_exactly_a<power>(b)
+
+       } else if (is_exactly_a<power>(b)) {
+               ex p = b.op(0);
+               if (p.is_equal(a)) {
+                       // a = p, b = p^n, gcd = p
+                       if (ca)
+                               *ca = _ex1;
+                       if (cb)
+                               *cb = power(p, b.op(1) - 1);
+                       return p;
+               }
+
+               ex p_co, apart_co;
+               const ex& exp_b(b.op(1));
+               ex p_gcd = gcd(a, p, &apart_co, &p_co, false);
+               if (p_gcd.is_equal(_ex1)) {
+                       // b=p(x)^n, gcd(a, p) = 1 ==> gcd(a, b) == 1
+                       if (ca)
+                               *ca = a;
+                       if (cb)
+                               *cb = b;
+                       return _ex1;
+               } else {
+                       // there are common factors:
+                       // a(x) = g(x) A(x), b(x) = g(x)^n B(x)^n ==> gcd = g(x) gcd(g(x)^(n-1) A(x)^n, B(x))
+
+                       return p_gcd*gcd(apart_co, power(p_gcd, exp_b-1)*power(p_co, exp_b), ca, cb, false);
+               } // p_gcd.is_equal(_ex1)
+       }
+#endif
+
+       // Some trivial cases
        ex aex = a.expand(), bex = b.expand();
-    if (aex.is_zero()) {
-        if (ca)
-            *ca = exZERO();
-        if (cb)
-            *cb = exONE();
-        return b;
-    }
-    if (bex.is_zero()) {
-        if (ca)
-            *ca = exONE();
-        if (cb)
-            *cb = exZERO();
-        return a;
-    }
-    if (aex.is_equal(exONE()) || bex.is_equal(exONE())) {
-        if (ca)
-            *ca = a;
-        if (cb)
-            *cb = b;
-        return exONE();
-    }
+       if (aex.is_zero()) {
+               if (ca)
+                       *ca = _ex0;
+               if (cb)
+                       *cb = _ex1;
+               return b;
+       }
+       if (bex.is_zero()) {
+               if (ca)
+                       *ca = _ex1;
+               if (cb)
+                       *cb = _ex0;
+               return a;
+       }
+       if (aex.is_equal(_ex1) || bex.is_equal(_ex1)) {
+               if (ca)
+                       *ca = a;
+               if (cb)
+                       *cb = b;
+               return _ex1;
+       }
 #if FAST_COMPARE
-    if (a.is_equal(b)) {
-        if (ca)
-            *ca = exONE();
-        if (cb)
-            *cb = exONE();
-        return a;
-    }
+       if (a.is_equal(b)) {
+               if (ca)
+                       *ca = _ex1;
+               if (cb)
+                       *cb = _ex1;
+               return a;
+       }
+#endif
+
+       if (is_a<symbol>(aex)) {
+               if (! bex.subs(aex==_ex0, subs_options::no_pattern).is_zero()) {
+                       if (ca)
+                               *ca = a;
+                       if (cb)
+                               *cb = b;
+                       return _ex1;
+               }
+       }
+
+       if (is_a<symbol>(bex)) {
+               if (! aex.subs(bex==_ex0, subs_options::no_pattern).is_zero()) {
+                       if (ca)
+                               *ca = a;
+                       if (cb)
+                               *cb = b;
+                       return _ex1;
+               }
+       }
+
+       // Gather symbol statistics
+       sym_desc_vec sym_stats;
+       get_symbol_stats(a, b, sym_stats);
+
+       // The symbol with least degree is our main variable
+       sym_desc_vec::const_iterator var = sym_stats.begin();
+       const ex &x = var->sym;
+
+       // Cancel trivial common factor
+       int ldeg_a = var->ldeg_a;
+       int ldeg_b = var->ldeg_b;
+       int min_ldeg = std::min(ldeg_a,ldeg_b);
+       if (min_ldeg > 0) {
+               ex common = power(x, min_ldeg);
+               return gcd((aex / common).expand(), (bex / common).expand(), ca, cb, false) * common;
+       }
+
+       // Try to eliminate variables
+       if (var->deg_a == 0) {
+               ex bex_u, bex_c, bex_p;
+               bex.unitcontprim(x, bex_u, bex_c, bex_p);
+               ex g = gcd(aex, bex_c, ca, cb, false);
+               if (cb)
+                       *cb *= bex_u * bex_p;
+               return g;
+       } else if (var->deg_b == 0) {
+               ex aex_u, aex_c, aex_p;
+               aex.unitcontprim(x, aex_u, aex_c, aex_p);
+               ex g = gcd(aex_c, bex, ca, cb, false);
+               if (ca)
+                       *ca *= aex_u * aex_p;
+               return g;
+       }
+
+       // Try heuristic algorithm first, fall back to PRS if that failed
+       ex g;
+       try {
+               g = heur_gcd(aex, bex, ca, cb, var);
+       } catch (gcdheu_failed) {
+               g = fail();
+       }
+       if (is_exactly_a<fail>(g)) {
+#if STATISTICS
+               heur_gcd_failed++;
 #endif
-    if (is_ex_exactly_of_type(aex, numeric) && is_ex_exactly_of_type(bex, numeric)) {
-        numeric g = gcd(ex_to_numeric(aex), ex_to_numeric(bex));
-        if (ca)
-            *ca = ex_to_numeric(aex) / g;
-        if (cb)
-            *cb = ex_to_numeric(bex) / g;
-        return g;
-    }
-    if (check_args && !a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial)) {
-        throw(std::invalid_argument("gcd: arguments must be polynomials over the rationals"));
-    }
-
-    // Gather symbol statistics
-    sym_desc_vec sym_stats;
-    get_symbol_stats(a, b, sym_stats);
-
-    // The symbol with least degree is our main variable
-    sym_desc_vec::const_iterator var = sym_stats.begin();
-    const symbol *x = var->sym;
-
-    // Cancel trivial common factor
-    int ldeg_a = var->ldeg_a;
-    int ldeg_b = var->ldeg_b;
-    int min_ldeg = min(ldeg_a, ldeg_b);
-    if (min_ldeg > 0) {
-        ex common = power(*x, min_ldeg);
-//clog << "trivial common factor " << common << endl;
-        return gcd((aex / common).expand(), (bex / common).expand(), ca, cb, false) * common;
-    }
-
-    // Try to eliminate variables
-    if (var->deg_a == 0) {
-//clog << "eliminating variable " << *x << " from b" << endl;
-        ex c = bex.content(*x);
-        ex g = gcd(aex, c, ca, cb, false);
-        if (cb)
-            *cb *= bex.unit(*x) * bex.primpart(*x, c);
-        return g;
-    } else if (var->deg_b == 0) {
-//clog << "eliminating variable " << *x << " from a" << endl;
-        ex c = aex.content(*x);
-        ex g = gcd(c, bex, ca, cb, false);
-        if (ca)
-            *ca *= aex.unit(*x) * aex.primpart(*x, c);
-        return g;
-    }
-
-    // Try heuristic algorithm first, fall back to PRS if that failed
-    ex g;
-    try {
-        g = heur_gcd(aex, bex, ca, cb, var);
-    } catch (gcdheu_failed) {
-        g = *new ex(fail());
-    }
-    if (is_ex_exactly_of_type(g, fail)) {
-//clog << "heuristics failed\n";
-        g = sr_gcd(aex, bex, x);
-        if (ca)
-            divide(aex, g, *ca, false);
-        if (cb)
-            divide(bex, g, *cb, false);
-    }
-    return g;
+               g = sr_gcd(aex, bex, var);
+               if (g.is_equal(_ex1)) {
+                       // Keep cofactors factored if possible
+                       if (ca)
+                               *ca = a;
+                       if (cb)
+                               *cb = b;
+               } else {
+                       if (ca)
+                               divide(aex, g, *ca, false);
+                       if (cb)
+                               divide(bex, g, *cb, false);
+               }
+       } else {
+               if (g.is_equal(_ex1)) {
+                       // Keep cofactors factored if possible
+                       if (ca)
+                               *ca = a;
+                       if (cb)
+                               *cb = b;
+               }
+       }
+
+       return g;
 }
 
 
@@ -1156,14 +1605,14 @@ ex gcd(const ex &a, const ex &b, ex *ca, ex *cb, bool check_args)
  *  @return the LCM as a new expression */
 ex lcm(const ex &a, const ex &b, bool check_args)
 {
-    if (is_ex_exactly_of_type(a, numeric) && is_ex_exactly_of_type(b, numeric))
-        return gcd(ex_to_numeric(a), ex_to_numeric(b));
-    if (check_args && !a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial))
-        throw(std::invalid_argument("lcm: arguments must be polynomials over the rationals"));
-    
-    ex ca, cb;
-    ex g = gcd(a, b, &ca, &cb, false);
-    return ca * cb * g;
+       if (is_exactly_a<numeric>(a) && is_exactly_a<numeric>(b))
+               return lcm(ex_to<numeric>(a), ex_to<numeric>(b));
+       if (check_args && (!a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial)))
+               throw(std::invalid_argument("lcm: arguments must be polynomials over the rationals"));
+       
+       ex ca, cb;
+       ex g = gcd(a, b, &ca, &cb, false);
+       return ca * cb * g;
 }
 
 
@@ -1171,70 +1620,204 @@ ex lcm(const ex &a, const ex &b, bool check_args)
  *  Square-free factorization
  */
 
-// Univariate GCD of polynomials in Q[x] (used internally by sqrfree()).
-// a and b can be multivariate polynomials but they are treated as univariate polynomials in x.
-static ex univariate_gcd(const ex &a, const ex &b, const symbol &x)
-{
-    if (a.is_zero())
-        return b;
-    if (b.is_zero())
-        return a;
-    if (a.is_equal(exONE()) || b.is_equal(exONE()))
-        return exONE();
-    if (is_ex_of_type(a, numeric) && is_ex_of_type(b, numeric))
-        return gcd(ex_to_numeric(a), ex_to_numeric(b));
-    if (!a.info(info_flags::rational_polynomial) || !b.info(info_flags::rational_polynomial))
-        throw(std::invalid_argument("univariate_gcd: arguments must be polynomials over the rationals"));
-
-    // Euclidean algorithm
-    ex c, d, r;
-    if (a.degree(x) >= b.degree(x)) {
-        c = a;
-        d = b;
-    } else {
-        c = b;
-        d = a;
-    }
-    for (;;) {
-        r = rem(c, d, x, false);
-        if (r.is_zero())
-            break;
-        c = d;
-        d = r;
-    }
-    return d / d.lcoeff(x);
+/** Compute square-free factorization of multivariate polynomial a(x) using
+ *  Yun's algorithm.  Used internally by sqrfree().
+ *
+ *  @param a  multivariate polynomial over Z[X], treated here as univariate
+ *            polynomial in x.
+ *  @param x  variable to factor in
+ *  @return   vector of factors sorted in ascending degree */
+static exvector sqrfree_yun(const ex &a, const symbol &x)
+{
+       exvector res;
+       ex w = a;
+       ex z = w.diff(x);
+       ex g = gcd(w, z);
+       if (g.is_equal(_ex1)) {
+               res.push_back(a);
+               return res;
+       }
+       ex y;
+       do {
+               w = quo(w, g, x);
+               y = quo(z, g, x);
+               z = y - w.diff(x);
+               g = gcd(w, z);
+               res.push_back(g);
+       } while (!z.is_zero());
+       return res;
 }
 
 
-/** Compute square-free factorization of multivariate polynomial a(x) using
- *  Yun´s algorithm.
+/** Compute a square-free factorization of a multivariate polynomial in Q[X].
+ *
+ *  @param a  multivariate polynomial over Q[X]
+ *  @param l  lst of variables to factor in, may be left empty for autodetection
+ *  @return   a square-free factorization of \p a.
+ *
+ * \note
+ * A polynomial \f$p(X) \in C[X]\f$ is said <EM>square-free</EM>
+ * if, whenever any two polynomials \f$q(X)\f$ and \f$r(X)\f$
+ * are such that
+ * \f[
+ *     p(X) = q(X)^2 r(X),
+ * \f]
+ * we have \f$q(X) \in C\f$.
+ * This means that \f$p(X)\f$ has no repeated factors, apart
+ * eventually from constants.
+ * Given a polynomial \f$p(X) \in C[X]\f$, we say that the
+ * decomposition
+ * \f[
+ *   p(X) = b \cdot p_1(X)^{a_1} \cdot p_2(X)^{a_2} \cdots p_r(X)^{a_r}
+ * \f]
+ * is a <EM>square-free factorization</EM> of \f$p(X)\f$ if the
+ * following conditions hold:
+ * -#  \f$b \in C\f$ and \f$b \neq 0\f$;
+ * -#  \f$a_i\f$ is a positive integer for \f$i = 1, \ldots, r\f$;
+ * -#  the degree of the polynomial \f$p_i\f$ is strictly positive
+ *     for \f$i = 1, \ldots, r\f$;
+ * -#  the polynomial \f$\Pi_{i=1}^r p_i(X)\f$ is square-free.
+ *
+ * Square-free factorizations need not be unique.  For example, if
+ * \f$a_i\f$ is even, we could change the polynomial \f$p_i(X)\f$
+ * into \f$-p_i(X)\f$.
+ * Observe also that the factors \f$p_i(X)\f$ need not be irreducible
+ * polynomials.
+ */
+ex sqrfree(const ex &a, const lst &l)
+{
+       if (is_exactly_a<numeric>(a) ||     // algorithm does not trap a==0
+           is_a<symbol>(a))        // shortcut
+               return a;
+
+       // If no lst of variables to factorize in was specified we have to
+       // invent one now.  Maybe one can optimize here by reversing the order
+       // or so, I don't know.
+       lst args;
+       if (l.nops()==0) {
+               sym_desc_vec sdv;
+               get_symbol_stats(a, _ex0, sdv);
+               sym_desc_vec::const_iterator it = sdv.begin(), itend = sdv.end();
+               while (it != itend) {
+                       args.append(it->sym);
+                       ++it;
+               }
+       } else {
+               args = l;
+       }
+
+       // Find the symbol to factor in at this stage
+       if (!is_a<symbol>(args.op(0)))
+               throw (std::runtime_error("sqrfree(): invalid factorization variable"));
+       const symbol &x = ex_to<symbol>(args.op(0));
+
+       // convert the argument from something in Q[X] to something in Z[X]
+       const numeric lcm = lcm_of_coefficients_denominators(a);
+       const ex tmp = multiply_lcm(a,lcm);
+
+       // find the factors
+       exvector factors = sqrfree_yun(tmp, x);
+
+       // construct the next list of symbols with the first element popped
+       lst newargs = args;
+       newargs.remove_first();
+
+       // recurse down the factors in remaining variables
+       if (newargs.nops()>0) {
+               exvector::iterator i = factors.begin();
+               while (i != factors.end()) {
+                       *i = sqrfree(*i, newargs);
+                       ++i;
+               }
+       }
+
+       // Done with recursion, now construct the final result
+       ex result = _ex1;
+       exvector::const_iterator it = factors.begin(), itend = factors.end();
+       for (int p = 1; it!=itend; ++it, ++p)
+               result *= power(*it, p);
+
+       // Yun's algorithm does not account for constant factors.  (For univariate
+       // polynomials it works only in the monic case.)  We can correct this by
+       // inserting what has been lost back into the result.  For completeness
+       // we'll also have to recurse down that factor in the remaining variables.
+       if (newargs.nops()>0)
+               result *= sqrfree(quo(tmp, result, x), newargs);
+       else
+               result *= quo(tmp, result, x);
+
+       // Put in the reational overall factor again and return
+       return result * lcm.inverse();
+}
+
+
+/** Compute square-free partial fraction decomposition of rational function
+ *  a(x).
  *
- * @param a  multivariate polynomial
- * @param x  variable to factor in
- * @return factored polynomial */
-ex sqrfree(const ex &a, const symbol &x)
-{
-    int i = 1;
-    ex res = exONE();
-    ex b = a.diff(x);
-    ex c = univariate_gcd(a, b, x);
-    ex w;
-    if (c.is_equal(exONE())) {
-        w = a;
-    } else {
-        w = quo(a, c, x);
-        ex y = quo(b, c, x);
-        ex z = y - w.diff(x);
-        while (!z.is_zero()) {
-            ex g = univariate_gcd(w, z, x);
-            res *= power(g, i);
-            w = quo(w, g, x);
-            y = quo(z, g, x);
-            z = y - w.diff(x);
-            i++;
-        }
-    }
-    return res * power(w, i);
+ *  @param a rational function over Z[x], treated as univariate polynomial
+ *           in x
+ *  @param x variable to factor in
+ *  @return decomposed rational function */
+ex sqrfree_parfrac(const ex & a, const symbol & x)
+{
+       // Find numerator and denominator
+       ex nd = numer_denom(a);
+       ex numer = nd.op(0), denom = nd.op(1);
+//clog << "numer = " << numer << ", denom = " << denom << endl;
+
+       // Convert N(x)/D(x) -> Q(x) + R(x)/D(x), so degree(R) < degree(D)
+       ex red_poly = quo(numer, denom, x), red_numer = rem(numer, denom, x).expand();
+//clog << "red_poly = " << red_poly << ", red_numer = " << red_numer << endl;
+
+       // Factorize denominator and compute cofactors
+       exvector yun = sqrfree_yun(denom, x);
+//clog << "yun factors: " << exprseq(yun) << endl;
+       size_t num_yun = yun.size();
+       exvector factor; factor.reserve(num_yun);
+       exvector cofac; cofac.reserve(num_yun);
+       for (size_t i=0; i<num_yun; i++) {
+               if (!yun[i].is_equal(_ex1)) {
+                       for (size_t j=0; j<=i; j++) {
+                               factor.push_back(pow(yun[i], j+1));
+                               ex prod = _ex1;
+                               for (size_t k=0; k<num_yun; k++) {
+                                       if (k == i)
+                                               prod *= pow(yun[k], i-j);
+                                       else
+                                               prod *= pow(yun[k], k+1);
+                               }
+                               cofac.push_back(prod.expand());
+                       }
+               }
+       }
+       size_t num_factors = factor.size();
+//clog << "factors  : " << exprseq(factor) << endl;
+//clog << "cofactors: " << exprseq(cofac) << endl;
+
+       // Construct coefficient matrix for decomposition
+       int max_denom_deg = denom.degree(x);
+       matrix sys(max_denom_deg + 1, num_factors);
+       matrix rhs(max_denom_deg + 1, 1);
+       for (int i=0; i<=max_denom_deg; i++) {
+               for (size_t j=0; j<num_factors; j++)
+                       sys(i, j) = cofac[j].coeff(x, i);
+               rhs(i, 0) = red_numer.coeff(x, i);
+       }
+//clog << "coeffs: " << sys << endl;
+//clog << "rhs   : " << rhs << endl;
+
+       // Solve resulting linear system
+       matrix vars(num_factors, 1);
+       for (size_t i=0; i<num_factors; i++)
+               vars(i, 0) = symbol();
+       matrix sol = sys.solve(vars, rhs);
+
+       // Sum up decomposed fractions
+       ex sum = 0;
+       for (size_t i=0; i<num_factors; i++)
+               sum += sol(i, 0) / factor[i];
+
+       return red_poly + sum;
 }
 
 
@@ -1242,42 +1825,90 @@ ex sqrfree(const ex &a, const symbol &x)
  *  Normal form of rational functions
  */
 
-// Create a symbol for replacing the expression "e" (or return a previously
-// assigned symbol). The symbol is appended to sym_list and returned, the
-// expression is appended to repl_list.
-static ex replace_with_symbol(const ex &e, lst &sym_lst, lst &repl_lst)
+/*
+ *  Note: The internal normal() functions (= basic::normal() and overloaded
+ *  functions) all return lists of the form {numerator, denominator}. This
+ *  is to get around mul::eval()'s automatic expansion of numeric coefficients.
+ *  E.g. (a+b)/3 is automatically converted to a/3+b/3 but we want to keep
+ *  the information that (a+b) is the numerator and 3 is the denominator.
+ */
+
+
+/** Create a symbol for replacing the expression "e" (or return a previously
+ *  assigned symbol). The symbol and expression are appended to repl, for
+ *  a later application of subs().
+ *  @see ex::normal */
+static ex replace_with_symbol(const ex & e, exmap & repl, exmap & rev_lookup)
 {
-    // Expression already in repl_lst? Then return the assigned symbol
-    for (int i=0; i<repl_lst.nops(); i++)
-        if (repl_lst.op(i).is_equal(e))
-            return sym_lst.op(i);
+       // Expression already replaced? Then return the assigned symbol
+       exmap::const_iterator it = rev_lookup.find(e);
+       if (it != rev_lookup.end())
+               return it->second;
+       
+       // Otherwise create new symbol and add to list, taking care that the
+       // replacement expression doesn't itself contain symbols from repl,
+       // because subs() is not recursive
+       ex es = (new symbol)->setflag(status_flags::dynallocated);
+       ex e_replaced = e.subs(repl, subs_options::no_pattern);
+       repl.insert(std::make_pair(es, e_replaced));
+       rev_lookup.insert(std::make_pair(e_replaced, es));
+       return es;
+}
 
-    // Otherwise create new symbol and add to list, taking care that the
-       // replacement expression doesn't contain symbols from the sym_lst
+/** Create a symbol for replacing the expression "e" (or return a previously
+ *  assigned symbol). The symbol and expression are appended to repl, and the
+ *  symbol is returned.
+ *  @see basic::to_rational
+ *  @see basic::to_polynomial */
+static ex replace_with_symbol(const ex & e, exmap & repl)
+{
+       // Expression already replaced? Then return the assigned symbol
+       for (exmap::const_iterator it = repl.begin(); it != repl.end(); ++it)
+               if (it->second.is_equal(e))
+                       return it->first;
+       
+       // Otherwise create new symbol and add to list, taking care that the
+       // replacement expression doesn't itself contain symbols from repl,
        // because subs() is not recursive
-       symbol s;
-       ex es(s);
-       ex e_replaced = e.subs(sym_lst, repl_lst);
-    sym_lst.append(es);
-    repl_lst.append(e_replaced);
-    return es;
+       ex es = (new symbol)->setflag(status_flags::dynallocated);
+       ex e_replaced = e.subs(repl, subs_options::no_pattern);
+       repl.insert(std::make_pair(es, e_replaced));
+       return es;
 }
 
 
-/** Default implementation of ex::normal(). It replaces the object with a
- *  temporary symbol.
+/** Function object to be applied by basic::normal(). */
+struct normal_map_function : public map_function {
+       int level;
+       normal_map_function(int l) : level(l) {}
+       ex operator()(const ex & e) { return normal(e, level); }
+};
+
+/** Default implementation of ex::normal(). It normalizes the children and
+ *  replaces the object with a temporary symbol.
  *  @see ex::normal */
-ex basic::normal(lst &sym_lst, lst &repl_lst, int level) const
+ex basic::normal(exmap & repl, exmap & rev_lookup, int level) const
 {
-    return replace_with_symbol(*this, sym_lst, repl_lst);
+       if (nops() == 0)
+               return (new lst(replace_with_symbol(*this, repl, rev_lookup), _ex1))->setflag(status_flags::dynallocated);
+       else {
+               if (level == 1)
+                       return (new lst(replace_with_symbol(*this, repl, rev_lookup), _ex1))->setflag(status_flags::dynallocated);
+               else if (level == -max_recursion_level)
+                       throw(std::runtime_error("max recursion level reached"));
+               else {
+                       normal_map_function map_normal(level - 1);
+                       return (new lst(replace_with_symbol(map(map_normal), repl, rev_lookup), _ex1))->setflag(status_flags::dynallocated);
+               }
+       }
 }
 
 
-/** Implementation of ex::normal() for symbols. This returns the unmodifies symbol.
+/** Implementation of ex::normal() for symbols. This returns the unmodified symbol.
  *  @see ex::normal */
-ex symbol::normal(lst &sym_lst, lst &repl_lst, int level) const
+ex symbol::normal(exmap & repl, exmap & rev_lookup, int level) const
 {
-    return *this;
+       return (new lst(*this, _ex1))->setflag(status_flags::dynallocated);
 }
 
 
@@ -1285,180 +1916,248 @@ ex symbol::normal(lst &sym_lst, lst &repl_lst, int level) const
  *  into re+I*im and replaces I and non-rational real numbers with a temporary
  *  symbol.
  *  @see ex::normal */
-ex numeric::normal(lst &sym_lst, lst &repl_lst, int level) const
+ex numeric::normal(exmap & repl, exmap & rev_lookup, int level) const
 {
-    if (is_real())
-        if (is_rational())
-            return *this;
-               else
-                   return replace_with_symbol(*this, sym_lst, repl_lst);
-    else { // complex
-        numeric re = real(), im = imag();
-               ex re_ex = re.is_rational() ? re : replace_with_symbol(re, sym_lst, repl_lst);
-               ex im_ex = im.is_rational() ? im : replace_with_symbol(im, sym_lst, repl_lst);
-               return re_ex + im_ex * replace_with_symbol(I, sym_lst, repl_lst);
+       numeric num = numer();
+       ex numex = num;
+
+       if (num.is_real()) {
+               if (!num.is_integer())
+                       numex = replace_with_symbol(numex, repl, rev_lookup);
+       } else { // complex
+               numeric re = num.real(), im = num.imag();
+               ex re_ex = re.is_rational() ? re : replace_with_symbol(re, repl, rev_lookup);
+               ex im_ex = im.is_rational() ? im : replace_with_symbol(im, repl, rev_lookup);
+               numex = re_ex + im_ex * replace_with_symbol(I, repl, rev_lookup);
        }
-}
 
+       // Denominator is always a real integer (see numeric::denom())
+       return (new lst(numex, denom()))->setflag(status_flags::dynallocated);
+}
 
-/*
- *  Helper function for fraction cancellation (returns cancelled fraction n/d)
- */
 
+/** Fraction cancellation.
+ *  @param n  numerator
+ *  @param d  denominator
+ *  @return cancelled fraction {n, d} as a list */
 static ex frac_cancel(const ex &n, const ex &d)
 {
-    ex num = n;
-    ex den = d;
-    ex pre_factor = exONE();
-
-    // Handle special cases where numerator or denominator is 0
-    if (num.is_zero())
-        return exZERO();
-    if (den.expand().is_zero())
-        throw(std::overflow_error("frac_cancel: division by zero in frac_cancel"));
-
-    // More special cases
-    if (is_ex_exactly_of_type(den, numeric))
-        return num / den;
-    if (num.is_zero())
-        return exZERO();
-
-    // Bring numerator and denominator to Z[X] by multiplying with
-    // LCM of all coefficients' denominators
-    ex num_lcm = lcm_of_coefficients_denominators(num);
-    ex den_lcm = lcm_of_coefficients_denominators(den);
-    num *= num_lcm;
-    den *= den_lcm;
-    pre_factor = den_lcm / num_lcm;
-
-    // Cancel GCD from numerator and denominator
-    ex cnum, cden;
-    if (gcd(num, den, &cnum, &cden, false) != exONE()) {
+       ex num = n;
+       ex den = d;
+       numeric pre_factor = *_num1_p;
+
+//std::clog << "frac_cancel num = " << num << ", den = " << den << std::endl;
+
+       // Handle trivial case where denominator is 1
+       if (den.is_equal(_ex1))
+               return (new lst(num, den))->setflag(status_flags::dynallocated);
+
+       // Handle special cases where numerator or denominator is 0
+       if (num.is_zero())
+               return (new lst(num, _ex1))->setflag(status_flags::dynallocated);
+       if (den.expand().is_zero())
+               throw(std::overflow_error("frac_cancel: division by zero in frac_cancel"));
+
+       // Bring numerator and denominator to Z[X] by multiplying with
+       // LCM of all coefficients' denominators
+       numeric num_lcm = lcm_of_coefficients_denominators(num);
+       numeric den_lcm = lcm_of_coefficients_denominators(den);
+       num = multiply_lcm(num, num_lcm);
+       den = multiply_lcm(den, den_lcm);
+       pre_factor = den_lcm / num_lcm;
+
+       // Cancel GCD from numerator and denominator
+       ex cnum, cden;
+       if (gcd(num, den, &cnum, &cden, false) != _ex1) {
                num = cnum;
                den = cden;
        }
 
        // Make denominator unit normal (i.e. coefficient of first symbol
        // as defined by get_first_symbol() is made positive)
-       const symbol *x;
-       if (get_first_symbol(den, x)) {
-               if (den.unit(*x).compare(exZERO()) < 0) {
-                       num *= exMINUSONE();
-                       den *= exMINUSONE();
+       if (is_exactly_a<numeric>(den)) {
+               if (ex_to<numeric>(den).is_negative()) {
+                       num *= _ex_1;
+                       den *= _ex_1;
+               }
+       } else {
+               ex x;
+               if (get_first_symbol(den, x)) {
+                       GINAC_ASSERT(is_exactly_a<numeric>(den.unit(x)));
+                       if (ex_to<numeric>(den.unit(x)).is_negative()) {
+                               num *= _ex_1;
+                               den *= _ex_1;
+                       }
                }
        }
-    return pre_factor * num / den;
+
+       // Return result as list
+//std::clog << " returns num = " << num << ", den = " << den << ", pre_factor = " << pre_factor << std::endl;
+       return (new lst(num * pre_factor.numer(), den * pre_factor.denom()))->setflag(status_flags::dynallocated);
 }
 
 
 /** Implementation of ex::normal() for a sum. It expands terms and performs
  *  fractional addition.
  *  @see ex::normal */
-ex add::normal(lst &sym_lst, lst &repl_lst, int level) const
-{
-    // Normalize and expand children
-    exvector o;
-    o.reserve(seq.size()+1);
-    epvector::const_iterator it = seq.begin(), itend = seq.end();
-    while (it != itend) {
-        ex n = recombine_pair_to_ex(*it).bp->normal(sym_lst, repl_lst, level-1).expand();
-        if (is_ex_exactly_of_type(n, add)) {
-            epvector::const_iterator bit = (static_cast<add *>(n.bp))->seq.begin(), bitend = (static_cast<add *>(n.bp))->seq.end();
-            while (bit != bitend) {
-                o.push_back(recombine_pair_to_ex(*bit));
-                bit++;
-            }
-            o.push_back((static_cast<add *>(n.bp))->overall_coeff);
-        } else
-            o.push_back(n);
-        it++;
-    }
-    o.push_back(overall_coeff.bp->normal(sym_lst, repl_lst, level-1));
-
-    // Determine common denominator
-    ex den = exONE();
-    exvector::const_iterator ait = o.begin(), aitend = o.end();
-    while (ait != aitend) {
-        den = lcm((*ait).denom(false), den, false);
-        ait++;
-    }
-
-    // Add fractions
-    if (den.is_equal(exONE()))
-        return (new add(o))->setflag(status_flags::dynallocated);
-    else {
-        exvector num_seq;
-        for (ait=o.begin(); ait!=aitend; ait++) {
-            ex q;
-            if (!divide(den, (*ait).denom(false), q, false)) {
-                // should not happen
-                throw(std::runtime_error("invalid expression in add::normal, division failed"));
-            }
-            num_seq.push_back((*ait).numer(false) * q);
-        }
-        ex num = add(num_seq);
-
-        // Cancel common factors from num/den
-        return frac_cancel(num, den);
-    }
+ex add::normal(exmap & repl, exmap & rev_lookup, int level) const
+{
+       if (level == 1)
+               return (new lst(replace_with_symbol(*this, repl, rev_lookup), _ex1))->setflag(status_flags::dynallocated);
+       else if (level == -max_recursion_level)
+               throw(std::runtime_error("max recursion level reached"));
+
+       // Normalize children and split each one into numerator and denominator
+       exvector nums, dens;
+       nums.reserve(seq.size()+1);
+       dens.reserve(seq.size()+1);
+       epvector::const_iterator it = seq.begin(), itend = seq.end();
+       while (it != itend) {
+               ex n = ex_to<basic>(recombine_pair_to_ex(*it)).normal(repl, rev_lookup, level-1);
+               nums.push_back(n.op(0));
+               dens.push_back(n.op(1));
+               it++;
+       }
+       ex n = ex_to<numeric>(overall_coeff).normal(repl, rev_lookup, level-1);
+       nums.push_back(n.op(0));
+       dens.push_back(n.op(1));
+       GINAC_ASSERT(nums.size() == dens.size());
+
+       // Now, nums is a vector of all numerators and dens is a vector of
+       // all denominators
+//std::clog << "add::normal uses " << nums.size() << " summands:\n";
+
+       // Add fractions sequentially
+       exvector::const_iterator num_it = nums.begin(), num_itend = nums.end();
+       exvector::const_iterator den_it = dens.begin(), den_itend = dens.end();
+//std::clog << " num = " << *num_it << ", den = " << *den_it << std::endl;
+       ex num = *num_it++, den = *den_it++;
+       while (num_it != num_itend) {
+//std::clog << " num = " << *num_it << ", den = " << *den_it << std::endl;
+               ex next_num = *num_it++, next_den = *den_it++;
+
+               // Trivially add sequences of fractions with identical denominators
+               while ((den_it != den_itend) && next_den.is_equal(*den_it)) {
+                       next_num += *num_it;
+                       num_it++; den_it++;
+               }
+
+               // Additiion of two fractions, taking advantage of the fact that
+               // the heuristic GCD algorithm computes the cofactors at no extra cost
+               ex co_den1, co_den2;
+               ex g = gcd(den, next_den, &co_den1, &co_den2, false);
+               num = ((num * co_den2) + (next_num * co_den1)).expand();
+               den *= co_den2;         // this is the lcm(den, next_den)
+       }
+//std::clog << " common denominator = " << den << std::endl;
+
+       // Cancel common factors from num/den
+       return frac_cancel(num, den);
 }
 
 
 /** Implementation of ex::normal() for a product. It cancels common factors
  *  from fractions.
  *  @see ex::normal() */
-ex mul::normal(lst &sym_lst, lst &repl_lst, int level) const
+ex mul::normal(exmap & repl, exmap & rev_lookup, int level) const
 {
-    // Normalize children
-    exvector o;
-    o.reserve(seq.size()+1);
-    epvector::const_iterator it = seq.begin(), itend = seq.end();
-    while (it != itend) {
-        o.push_back(recombine_pair_to_ex(*it).bp->normal(sym_lst, repl_lst, level-1));
-        it++;
-    }
-    o.push_back(overall_coeff.bp->normal(sym_lst, repl_lst, level-1));
-    ex n = (new mul(o))->setflag(status_flags::dynallocated);
-    return frac_cancel(n.numer(false), n.denom(false));
+       if (level == 1)
+               return (new lst(replace_with_symbol(*this, repl, rev_lookup), _ex1))->setflag(status_flags::dynallocated);
+       else if (level == -max_recursion_level)
+               throw(std::runtime_error("max recursion level reached"));
+
+       // Normalize children, separate into numerator and denominator
+       exvector num; num.reserve(seq.size());
+       exvector den; den.reserve(seq.size());
+       ex n;
+       epvector::const_iterator it = seq.begin(), itend = seq.end();
+       while (it != itend) {
+               n = ex_to<basic>(recombine_pair_to_ex(*it)).normal(repl, rev_lookup, level-1);
+               num.push_back(n.op(0));
+               den.push_back(n.op(1));
+               it++;
+       }
+       n = ex_to<numeric>(overall_coeff).normal(repl, rev_lookup, level-1);
+       num.push_back(n.op(0));
+       den.push_back(n.op(1));
+
+       // Perform fraction cancellation
+       return frac_cancel((new mul(num))->setflag(status_flags::dynallocated),
+                          (new mul(den))->setflag(status_flags::dynallocated));
 }
 
 
-/** Implementation of ex::normal() for powers. It normalizes the basis,
+/** Implementation of ex::normal([B) for powers. It normalizes the basis,
  *  distributes integer exponents to numerator and denominator, and replaces
  *  non-integer powers by temporary symbols.
  *  @see ex::normal */
-ex power::normal(lst &sym_lst, lst &repl_lst, int level) const
+ex power::normal(exmap & repl, exmap & rev_lookup, int level) const
 {
-    if (exponent.info(info_flags::integer)) {
-        // Integer powers are distributed
-        ex n = basis.bp->normal(sym_lst, repl_lst, level-1);
-        ex num = n.numer(false);
-        ex den = n.denom(false);
-        return power(num, exponent) / power(den, exponent);
-    } else {
-        // Non-integer powers are replaced by temporary symbol (after normalizing basis)
-        ex n = power(basis.bp->normal(sym_lst, repl_lst, level-1), exponent);
-        return replace_with_symbol(n, sym_lst, repl_lst);
-    }
+       if (level == 1)
+               return (new lst(replace_with_symbol(*this, repl, rev_lookup), _ex1))->setflag(status_flags::dynallocated);
+       else if (level == -max_recursion_level)
+               throw(std::runtime_error("max recursion level reached"));
+
+       // Normalize basis and exponent (exponent gets reassembled)
+       ex n_basis = ex_to<basic>(basis).normal(repl, rev_lookup, level-1);
+       ex n_exponent = ex_to<basic>(exponent).normal(repl, rev_lookup, level-1);
+       n_exponent = n_exponent.op(0) / n_exponent.op(1);
+
+       if (n_exponent.info(info_flags::integer)) {
+
+               if (n_exponent.info(info_flags::positive)) {
+
+                       // (a/b)^n -> {a^n, b^n}
+                       return (new lst(power(n_basis.op(0), n_exponent), power(n_basis.op(1), n_exponent)))->setflag(status_flags::dynallocated);
+
+               } else if (n_exponent.info(info_flags::negative)) {
+
+                       // (a/b)^-n -> {b^n, a^n}
+                       return (new lst(power(n_basis.op(1), -n_exponent), power(n_basis.op(0), -n_exponent)))->setflag(status_flags::dynallocated);
+               }
+
+       } else {
+
+               if (n_exponent.info(info_flags::positive)) {
+
+                       // (a/b)^x -> {sym((a/b)^x), 1}
+                       return (new lst(replace_with_symbol(power(n_basis.op(0) / n_basis.op(1), n_exponent), repl, rev_lookup), _ex1))->setflag(status_flags::dynallocated);
+
+               } else if (n_exponent.info(info_flags::negative)) {
+
+                       if (n_basis.op(1).is_equal(_ex1)) {
+
+                               // a^-x -> {1, sym(a^x)}
+                               return (new lst(_ex1, replace_with_symbol(power(n_basis.op(0), -n_exponent), repl, rev_lookup)))->setflag(status_flags::dynallocated);
+
+                       } else {
+
+                               // (a/b)^-x -> {sym((b/a)^x), 1}
+                               return (new lst(replace_with_symbol(power(n_basis.op(1) / n_basis.op(0), -n_exponent), repl, rev_lookup), _ex1))->setflag(status_flags::dynallocated);
+                       }
+               }
+       }
+
+       // (a/b)^x -> {sym((a/b)^x, 1}
+       return (new lst(replace_with_symbol(power(n_basis.op(0) / n_basis.op(1), n_exponent), repl, rev_lookup), _ex1))->setflag(status_flags::dynallocated);
 }
 
 
-/** Implementation of ex::normal() for series. It normalizes each coefficient and
- *  replaces the series by a temporary symbol.
+/** Implementation of ex::normal() for pseries. It normalizes each coefficient
+ *  and replaces the series by a temporary symbol.
  *  @see ex::normal */
-ex series::normal(lst &sym_lst, lst &repl_lst, int level) const
+ex pseries::normal(exmap & repl, exmap & rev_lookup, int level) const
 {
-    epvector new_seq;
-    new_seq.reserve(seq.size());
-
-    epvector::const_iterator it = seq.begin(), itend = seq.end();
-    while (it != itend) {
-        new_seq.push_back(expair(it->rest.normal(), it->coeff));
-        it++;
-    }
-
-    ex n = series(var, point, new_seq);
-    return replace_with_symbol(n, sym_lst, repl_lst);
+       epvector newseq;
+       epvector::const_iterator i = seq.begin(), end = seq.end();
+       while (i != end) {
+               ex restexp = i->rest.normal();
+               if (!restexp.is_zero())
+                       newseq.push_back(expair(restexp, i->coeff));
+               ++i;
+       }
+       ex n = pseries(relational(var,point), newseq);
+       return (new lst(replace_with_symbol(n, repl, rev_lookup), _ex1))->setflag(status_flags::dynallocated);
 }
 
 
@@ -1466,8 +2165,8 @@ ex series::normal(lst &sym_lst, lst &repl_lst, int level) const
  *  This function converts an expression to its normal form
  *  "numerator/denominator", where numerator and denominator are (relatively
  *  prime) polynomials. Any subexpressions which are not rational functions
- *  (like non-rational numbers, non-integer powers or functions like Sin(),
- *  Cos() etc.) are replaced by temporary symbols which are re-substituted by
+ *  (like non-rational numbers, non-integer powers or functions like sin(),
+ *  cos() etc.) are replaced by temporary symbols which are re-substituted by
  *  the (normalized) subexpressions before normal() returns (this way, any
  *  expression can be treated as a rational function). normal() is applied
  *  recursively to arguments of functions etc.
@@ -1476,12 +2175,401 @@ ex series::normal(lst &sym_lst, lst &repl_lst, int level) const
  *  @return normalized expression */
 ex ex::normal(int level) const
 {
-    lst sym_lst, repl_lst;
-    ex e = bp->normal(sym_lst, repl_lst, level);
-    if (sym_lst.nops() > 0)
-        return e.subs(sym_lst, repl_lst);
-    else
-        return e;
+       exmap repl, rev_lookup;
+
+       ex e = bp->normal(repl, rev_lookup, level);
+       GINAC_ASSERT(is_a<lst>(e));
+
+       // Re-insert replaced symbols
+       if (!repl.empty())
+               e = e.subs(repl, subs_options::no_pattern);
+
+       // Convert {numerator, denominator} form back to fraction
+       return e.op(0) / e.op(1);
+}
+
+/** Get numerator of an expression. If the expression is not of the normal
+ *  form "numerator/denominator", it is first converted to this form and
+ *  then the numerator is returned.
+ *
+ *  @see ex::normal
+ *  @return numerator */
+ex ex::numer() const
+{
+       exmap repl, rev_lookup;
+
+       ex e = bp->normal(repl, rev_lookup, 0);
+       GINAC_ASSERT(is_a<lst>(e));
+
+       // Re-insert replaced symbols
+       if (repl.empty())
+               return e.op(0);
+       else
+               return e.op(0).subs(repl, subs_options::no_pattern);
+}
+
+/** Get denominator of an expression. If the expression is not of the normal
+ *  form "numerator/denominator", it is first converted to this form and
+ *  then the denominator is returned.
+ *
+ *  @see ex::normal
+ *  @return denominator */
+ex ex::denom() const
+{
+       exmap repl, rev_lookup;
+
+       ex e = bp->normal(repl, rev_lookup, 0);
+       GINAC_ASSERT(is_a<lst>(e));
+
+       // Re-insert replaced symbols
+       if (repl.empty())
+               return e.op(1);
+       else
+               return e.op(1).subs(repl, subs_options::no_pattern);
+}
+
+/** Get numerator and denominator of an expression. If the expresison is not
+ *  of the normal form "numerator/denominator", it is first converted to this
+ *  form and then a list [numerator, denominator] is returned.
+ *
+ *  @see ex::normal
+ *  @return a list [numerator, denominator] */
+ex ex::numer_denom() const
+{
+       exmap repl, rev_lookup;
+
+       ex e = bp->normal(repl, rev_lookup, 0);
+       GINAC_ASSERT(is_a<lst>(e));
+
+       // Re-insert replaced symbols
+       if (repl.empty())
+               return e;
+       else
+               return e.subs(repl, subs_options::no_pattern);
+}
+
+
+/** Rationalization of non-rational functions.
+ *  This function converts a general expression to a rational function
+ *  by replacing all non-rational subexpressions (like non-rational numbers,
+ *  non-integer powers or functions like sin(), cos() etc.) to temporary
+ *  symbols. This makes it possible to use functions like gcd() and divide()
+ *  on non-rational functions by applying to_rational() on the arguments,
+ *  calling the desired function and re-substituting the temporary symbols
+ *  in the result. To make the last step possible, all temporary symbols and
+ *  their associated expressions are collected in the map specified by the
+ *  repl parameter, ready to be passed as an argument to ex::subs().
+ *
+ *  @param repl collects all temporary symbols and their replacements
+ *  @return rationalized expression */
+ex ex::to_rational(exmap & repl) const
+{
+       return bp->to_rational(repl);
+}
+
+// GiNaC 1.1 compatibility function
+ex ex::to_rational(lst & repl_lst) const
+{
+       // Convert lst to exmap
+       exmap m;
+       for (lst::const_iterator it = repl_lst.begin(); it != repl_lst.end(); ++it)
+               m.insert(std::make_pair(it->op(0), it->op(1)));
+
+       ex ret = bp->to_rational(m);
+
+       // Convert exmap back to lst
+       repl_lst.remove_all();
+       for (exmap::const_iterator it = m.begin(); it != m.end(); ++it)
+               repl_lst.append(it->first == it->second);
+
+       return ret;
+}
+
+ex ex::to_polynomial(exmap & repl) const
+{
+       return bp->to_polynomial(repl);
+}
+
+// GiNaC 1.1 compatibility function
+ex ex::to_polynomial(lst & repl_lst) const
+{
+       // Convert lst to exmap
+       exmap m;
+       for (lst::const_iterator it = repl_lst.begin(); it != repl_lst.end(); ++it)
+               m.insert(std::make_pair(it->op(0), it->op(1)));
+
+       ex ret = bp->to_polynomial(m);
+
+       // Convert exmap back to lst
+       repl_lst.remove_all();
+       for (exmap::const_iterator it = m.begin(); it != m.end(); ++it)
+               repl_lst.append(it->first == it->second);
+
+       return ret;
+}
+
+/** Default implementation of ex::to_rational(). This replaces the object with
+ *  a temporary symbol. */
+ex basic::to_rational(exmap & repl) const
+{
+       return replace_with_symbol(*this, repl);
+}
+
+ex basic::to_polynomial(exmap & repl) const
+{
+       return replace_with_symbol(*this, repl);
+}
+
+
+/** Implementation of ex::to_rational() for symbols. This returns the
+ *  unmodified symbol. */
+ex symbol::to_rational(exmap & repl) const
+{
+       return *this;
+}
+
+/** Implementation of ex::to_polynomial() for symbols. This returns the
+ *  unmodified symbol. */
+ex symbol::to_polynomial(exmap & repl) const
+{
+       return *this;
+}
+
+
+/** Implementation of ex::to_rational() for a numeric. It splits complex
+ *  numbers into re+I*im and replaces I and non-rational real numbers with a
+ *  temporary symbol. */
+ex numeric::to_rational(exmap & repl) const
+{
+       if (is_real()) {
+               if (!is_rational())
+                       return replace_with_symbol(*this, repl);
+       } else { // complex
+               numeric re = real();
+               numeric im = imag();
+               ex re_ex = re.is_rational() ? re : replace_with_symbol(re, repl);
+               ex im_ex = im.is_rational() ? im : replace_with_symbol(im, repl);
+               return re_ex + im_ex * replace_with_symbol(I, repl);
+       }
+       return *this;
+}
+
+/** Implementation of ex::to_polynomial() for a numeric. It splits complex
+ *  numbers into re+I*im and replaces I and non-integer real numbers with a
+ *  temporary symbol. */
+ex numeric::to_polynomial(exmap & repl) const
+{
+       if (is_real()) {
+               if (!is_integer())
+                       return replace_with_symbol(*this, repl);
+       } else { // complex
+               numeric re = real();
+               numeric im = imag();
+               ex re_ex = re.is_integer() ? re : replace_with_symbol(re, repl);
+               ex im_ex = im.is_integer() ? im : replace_with_symbol(im, repl);
+               return re_ex + im_ex * replace_with_symbol(I, repl);
+       }
+       return *this;
+}
+
+
+/** Implementation of ex::to_rational() for powers. It replaces non-integer
+ *  powers by temporary symbols. */
+ex power::to_rational(exmap & repl) const
+{
+       if (exponent.info(info_flags::integer))
+               return power(basis.to_rational(repl), exponent);
+       else
+               return replace_with_symbol(*this, repl);
+}
+
+/** Implementation of ex::to_polynomial() for powers. It replaces non-posint
+ *  powers by temporary symbols. */
+ex power::to_polynomial(exmap & repl) const
+{
+       if (exponent.info(info_flags::posint))
+               return power(basis.to_rational(repl), exponent);
+       else if (exponent.info(info_flags::negint))
+               return power(replace_with_symbol(power(basis, _ex_1), repl), -exponent);
+       else
+               return replace_with_symbol(*this, repl);
+}
+
+
+/** Implementation of ex::to_rational() for expairseqs. */
+ex expairseq::to_rational(exmap & repl) const
+{
+       epvector s;
+       s.reserve(seq.size());
+       epvector::const_iterator i = seq.begin(), end = seq.end();
+       while (i != end) {
+               s.push_back(split_ex_to_pair(recombine_pair_to_ex(*i).to_rational(repl)));
+               ++i;
+       }
+       ex oc = overall_coeff.to_rational(repl);
+       if (oc.info(info_flags::numeric))
+               return thisexpairseq(s, overall_coeff);
+       else
+               s.push_back(combine_ex_with_coeff_to_pair(oc, _ex1));
+       return thisexpairseq(s, default_overall_coeff());
+}
+
+/** Implementation of ex::to_polynomial() for expairseqs. */
+ex expairseq::to_polynomial(exmap & repl) const
+{
+       epvector s;
+       s.reserve(seq.size());
+       epvector::const_iterator i = seq.begin(), end = seq.end();
+       while (i != end) {
+               s.push_back(split_ex_to_pair(recombine_pair_to_ex(*i).to_polynomial(repl)));
+               ++i;
+       }
+       ex oc = overall_coeff.to_polynomial(repl);
+       if (oc.info(info_flags::numeric))
+               return thisexpairseq(s, overall_coeff);
+       else
+               s.push_back(combine_ex_with_coeff_to_pair(oc, _ex1));
+       return thisexpairseq(s, default_overall_coeff());
+}
+
+
+/** Remove the common factor in the terms of a sum 'e' by calculating the GCD,
+ *  and multiply it into the expression 'factor' (which needs to be initialized
+ *  to 1, unless you're accumulating factors). */
+static ex find_common_factor(const ex & e, ex & factor, exmap & repl)
+{
+       if (is_exactly_a<add>(e)) {
+
+               size_t num = e.nops();
+               exvector terms; terms.reserve(num);
+               ex gc;
+
+               // Find the common GCD
+               for (size_t i=0; i<num; i++) {
+                       ex x = e.op(i).to_polynomial(repl);
+
+                       if (is_exactly_a<add>(x) || is_exactly_a<mul>(x)) {
+                               ex f = 1;
+                               x = find_common_factor(x, f, repl);
+                               x *= f;
+                       }
+
+                       if (i == 0)
+                               gc = x;
+                       else
+                               gc = gcd(gc, x);
+
+                       terms.push_back(x);
+               }
+
+               if (gc.is_equal(_ex1))
+                       return e;
+
+               // The GCD is the factor we pull out
+               factor *= gc;
+
+               // Now divide all terms by the GCD
+               for (size_t i=0; i<num; i++) {
+                       ex x;
+
+                       // Try to avoid divide() because it expands the polynomial
+                       ex &t = terms[i];
+                       if (is_exactly_a<mul>(t)) {
+                               for (size_t j=0; j<t.nops(); j++) {
+                                       if (t.op(j).is_equal(gc)) {
+                                               exvector v; v.reserve(t.nops());
+                                               for (size_t k=0; k<t.nops(); k++) {
+                                                       if (k == j)
+                                                               v.push_back(_ex1);
+                                                       else
+                                                               v.push_back(t.op(k));
+                                               }
+                                               t = (new mul(v))->setflag(status_flags::dynallocated);
+                                               goto term_done;
+                                       }
+                               }
+                       }
+
+                       divide(t, gc, x);
+                       t = x;
+term_done:     ;
+               }
+               return (new add(terms))->setflag(status_flags::dynallocated);
+
+       } else if (is_exactly_a<mul>(e)) {
+
+               size_t num = e.nops();
+               exvector v; v.reserve(num);
+
+               for (size_t i=0; i<num; i++)
+                       v.push_back(find_common_factor(e.op(i), factor, repl));
+
+               return (new mul(v))->setflag(status_flags::dynallocated);
+
+       } else if (is_exactly_a<power>(e)) {
+               const ex e_exp(e.op(1));
+               if (e_exp.info(info_flags::posint)) {
+                       ex eb = e.op(0).to_polynomial(repl);
+                       ex factor_local(_ex1);
+                       ex pre_res = find_common_factor(eb, factor_local, repl);
+                       factor *= power(factor_local, e_exp);
+                       return power(pre_res, e_exp);
+                       
+               } else
+                       return e.to_polynomial(repl);
+
+       } else
+               return e;
+}
+
+
+/** Collect common factors in sums. This converts expressions like
+ *  'a*(b*x+b*y)' to 'a*b*(x+y)'. */
+ex collect_common_factors(const ex & e)
+{
+       if (is_exactly_a<add>(e) || is_exactly_a<mul>(e) || is_exactly_a<power>(e)) {
+
+               exmap repl;
+               ex factor = 1;
+               ex r = find_common_factor(e, factor, repl);
+               return factor.subs(repl, subs_options::no_pattern) * r.subs(repl, subs_options::no_pattern);
+
+       } else
+               return e;
+}
+
+
+/** Resultant of two expressions e1,e2 with respect to symbol s.
+ *  Method: Compute determinant of Sylvester matrix of e1,e2,s.  */
+ex resultant(const ex & e1, const ex & e2, const ex & s)
+{
+       const ex ee1 = e1.expand();
+       const ex ee2 = e2.expand();
+       if (!ee1.info(info_flags::polynomial) ||
+           !ee2.info(info_flags::polynomial))
+               throw(std::runtime_error("resultant(): arguments must be polynomials"));
+
+       const int h1 = ee1.degree(s);
+       const int l1 = ee1.ldegree(s);
+       const int h2 = ee2.degree(s);
+       const int l2 = ee2.ldegree(s);
+
+       const int msize = h1 + h2;
+       matrix m(msize, msize);
+
+       for (int l = h1; l >= l1; --l) {
+               const ex e = ee1.coeff(s, l);
+               for (int k = 0; k < h2; ++k)
+                       m(k, k+h1-l) = e;
+       }
+       for (int l = h2; l >= l2; --l) {
+               const ex e = ee2.coeff(s, l);
+               for (int k = 0; k < h1; ++k)
+                       m(k+h2, k+h2-l) = e;
+       }
+
+       return m.determinant();
 }
 
+
 } // namespace GiNaC
index bed6ed2f4fd841d43e57430129b3a7c53149710f..ce477e2abce695fc65650a0408352574cbe74f71 100644 (file)
@@ -3,7 +3,7 @@
  *  Implementation of GiNaC's symbolic exponentiation (basis^exponent). */
 
 /*
- *  GiNaC Copyright (C) 1999 Johannes Gutenberg University Mainz, Germany
+ *  GiNaC Copyright (C) 1999-2006 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
  *
  *  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  */
 
 #include <vector>
 #include <iostream>
 #include <stdexcept>
+#include <limits>
 
 #include "power.h"
 #include "expairseq.h"
 #include "add.h"
 #include "mul.h"
+#include "ncmul.h"
 #include "numeric.h"
-#include "relational.h"
+#include "constant.h"
+#include "operators.h"
+#include "inifcns_exp.h" // for log() in power::derivative()
+#include "matrix.h"
+#include "indexed.h"
 #include "symbol.h"
-#include "debugmsg.h"
+#include "lst.h"
+#include "archive.h"
+#include "utils.h"
 
 namespace GiNaC {
 
-typedef vector<int> intvector;
+GINAC_IMPLEMENT_REGISTERED_CLASS_OPT(power, basic,
+  print_func<print_dflt>(&power::do_print_dflt).
+  print_func<print_latex>(&power::do_print_latex).
+  print_func<print_csrc>(&power::do_print_csrc).
+  print_func<print_python>(&power::do_print_python).
+  print_func<print_python_repr>(&power::do_print_python_repr))
+
+typedef std::vector<int> intvector;
 
 //////////
-// default constructor, destructor, copy constructor assignment operator and helpers
+// default constructor
 //////////
 
-// public
+power::power() : inherited(&power::tinfo_static) { }
+
+//////////
+// other constructors
+//////////
+
+// all inlined
+
+//////////
+// archiving
+//////////
 
-power::power() : basic(TINFO_power)
+power::power(const archive_node &n, lst &sym_lst) : inherited(n, sym_lst)
 {
-    debugmsg("power default constructor",LOGLEVEL_CONSTRUCT);
+       n.find_ex("basis", basis, sym_lst);
+       n.find_ex("exponent", exponent, sym_lst);
 }
 
-power::~power()
+void power::archive(archive_node &n) const
 {
-    debugmsg("power destructor",LOGLEVEL_DESTRUCT);
-    destroy(0);
+       inherited::archive(n);
+       n.add_ex("basis", basis);
+       n.add_ex("exponent", exponent);
 }
 
-power::power(power const & other)
+DEFAULT_UNARCHIVE(power)
+
+//////////
+// functions overriding virtual functions from base classes
+//////////
+
+// public
+
+void power::print_power(const print_context & c, const char *powersymbol, const char *openbrace, const char *closebrace, unsigned level) const
 {
-    debugmsg("power copy constructor",LOGLEVEL_CONSTRUCT);
-    copy(other);
+       // Ordinary output of powers using '^' or '**'
+       if (precedence() <= level)
+               c.s << openbrace << '(';
+       basis.print(c, precedence());
+       c.s << powersymbol;
+       c.s << openbrace;
+       exponent.print(c, precedence());
+       c.s << closebrace;
+       if (precedence() <= level)
+               c.s << ')' << closebrace;
 }
 
-power const & power::operator=(power const & other)
+void power::do_print_dflt(const print_dflt & c, unsigned level) const
 {
-    debugmsg("power operator=",LOGLEVEL_ASSIGNMENT);
-    if (this != &other) {
-        destroy(1);
-        copy(other);
-    }
-    return *this;
-}
+       if (exponent.is_equal(_ex1_2)) {
 
-// protected
+               // Square roots are printed in a special way
+               c.s << "sqrt(";
+               basis.print(c);
+               c.s << ')';
 
-void power::copy(power const & other)
-{
-    basic::copy(other);
-    basis=other.basis;
-    exponent=other.exponent;
+       } else
+               print_power(c, "^", "", "", level);
 }
 
-void power::destroy(bool call_parent)
+void power::do_print_latex(const print_latex & c, unsigned level) const
 {
-    if (call_parent) basic::destroy(call_parent);
-}
+       if (is_exactly_a<numeric>(exponent) && ex_to<numeric>(exponent).is_negative()) {
 
-//////////
-// other constructors
-//////////
+               // Powers with negative numeric exponents are printed as fractions
+               c.s << "\\frac{1}{";
+               power(basis, -exponent).eval().print(c);
+               c.s << '}';
 
-// public
+       } else if (exponent.is_equal(_ex1_2)) {
 
-power::power(ex const & lh, ex const & rh) : basic(TINFO_power), basis(lh), exponent(rh)
-{
-    debugmsg("power constructor from ex,ex",LOGLEVEL_CONSTRUCT);
-    GINAC_ASSERT(basis.return_type()==return_types::commutative);
+               // Square roots are printed in a special way
+               c.s << "\\sqrt{";
+               basis.print(c);
+               c.s << '}';
+
+       } else
+               print_power(c, "^", "{", "}", level);
 }
 
-power::power(ex const & lh, numeric const & rh) : basic(TINFO_power), basis(lh), exponent(rh)
+static void print_sym_pow(const print_context & c, const symbol &x, int exp)
 {
-    debugmsg("power constructor from ex,numeric",LOGLEVEL_CONSTRUCT);
-    GINAC_ASSERT(basis.return_type()==return_types::commutative);
+       // Optimal output of integer powers of symbols to aid compiler CSE.
+       // C.f. ISO/IEC 14882:1998, section 1.9 [intro execution], paragraph 15
+       // to learn why such a parenthesation is really necessary.
+       if (exp == 1) {
+               x.print(c);
+       } else if (exp == 2) {
+               x.print(c);
+               c.s << "*";
+               x.print(c);
+       } else if (exp & 1) {
+               x.print(c);
+               c.s << "*";
+               print_sym_pow(c, x, exp-1);
+       } else {
+               c.s << "(";
+               print_sym_pow(c, x, exp >> 1);
+               c.s << ")*(";
+               print_sym_pow(c, x, exp >> 1);
+               c.s << ")";
+       }
 }
 
-//////////
-// functions overriding virtual functions from bases classes
-//////////
+void power::do_print_csrc(const print_csrc & c, unsigned level) const
+{
+       // Integer powers of symbols are printed in a special, optimized way
+       if (exponent.info(info_flags::integer)
+        && (is_a<symbol>(basis) || is_a<constant>(basis))) {
+               int exp = ex_to<numeric>(exponent).to_int();
+               if (exp > 0)
+                       c.s << '(';
+               else {
+                       exp = -exp;
+                       if (is_a<print_csrc_cl_N>(c))
+                               c.s << "recip(";
+                       else
+                               c.s << "1.0/(";
+               }
+               print_sym_pow(c, ex_to<symbol>(basis), exp);
+               c.s << ')';
+
+       // <expr>^-1 is printed as "1.0/<expr>" or with the recip() function of CLN
+       } else if (exponent.is_equal(_ex_1)) {
+               if (is_a<print_csrc_cl_N>(c))
+                       c.s << "recip(";
+               else
+                       c.s << "1.0/(";
+               basis.print(c);
+               c.s << ')';
+
+       // Otherwise, use the pow() or expt() (CLN) functions
+       } else {
+               if (is_a<print_csrc_cl_N>(c))
+                       c.s << "expt(";
+               else
+                       c.s << "pow(";
+               basis.print(c);
+               c.s << ',';
+               exponent.print(c);
+               c.s << ')';
+       }
+}
 
-// public
+void power::do_print_python(const print_python & c, unsigned level) const
+{
+       print_power(c, "**", "", "", level);
+}
 
-basic * power::duplicate() const
+void power::do_print_python_repr(const print_python_repr & c, unsigned level) const
 {
-    debugmsg("power duplicate",LOGLEVEL_DUPLICATE);
-    return new power(*this);
+       c.s << class_name() << '(';
+       basis.print(c);
+       c.s << ',';
+       exponent.print(c);
+       c.s << ')';
 }
 
 bool power::info(unsigned inf) const
 {
-    if (inf==info_flags::polynomial || inf==info_flags::integer_polynomial || inf==info_flags::rational_polynomial) {
-        return exponent.info(info_flags::nonnegint);
-    } else if (inf==info_flags::rational_function) {
-        return exponent.info(info_flags::integer);
-    } else {
-        return basic::info(inf);
-    }
+       switch (inf) {
+               case info_flags::polynomial:
+               case info_flags::integer_polynomial:
+               case info_flags::cinteger_polynomial:
+               case info_flags::rational_polynomial:
+               case info_flags::crational_polynomial:
+                       return exponent.info(info_flags::nonnegint) &&
+                              basis.info(inf);
+               case info_flags::rational_function:
+                       return exponent.info(info_flags::integer) &&
+                              basis.info(inf);
+               case info_flags::algebraic:
+                       return !exponent.info(info_flags::integer) ||
+                              basis.info(inf);
+       }
+       return inherited::info(inf);
 }
 
-int power::nops() const
+size_t power::nops() const
 {
-    return 2;
+       return 2;
 }
 
-ex & power::let_op(int const i)
+ex power::op(size_t i) const
 {
-    GINAC_ASSERT(i>=0);
-    GINAC_ASSERT(i<2);
+       GINAC_ASSERT(i<2);
 
-    return i==0 ? basis : exponent;
+       return i==0 ? basis : exponent;
 }
 
-int power::degree(symbol const & s) const
+ex power::map(map_function & f) const
 {
-    if (is_exactly_of_type(*exponent.bp,numeric)) {
-       if ((*basis.bp).compare(s)==0)
-            return ex_to_numeric(exponent).to_int();
-        else
-            return basis.degree(s) * ex_to_numeric(exponent).to_int();
-    }
-    return 0;
+       const ex &mapped_basis = f(basis);
+       const ex &mapped_exponent = f(exponent);
+
+       if (!are_ex_trivially_equal(basis, mapped_basis)
+        || !are_ex_trivially_equal(exponent, mapped_exponent))
+               return (new power(mapped_basis, mapped_exponent))->setflag(status_flags::dynallocated);
+       else
+               return *this;
 }
 
-int power::ldegree(symbol const & s) const 
+bool power::is_polynomial(const ex & var) const
 {
-    if (is_exactly_of_type(*exponent.bp,numeric)) {
-       if ((*basis.bp).compare(s)==0)
-            return ex_to_numeric(exponent).to_int();
-        else
-            return basis.ldegree(s) * ex_to_numeric(exponent).to_int();
-    }
-    return 0;
+       if (exponent.has(var))
+               return false;
+       if (!exponent.info(info_flags::nonnegint))
+               return false;
+       return basis.is_polynomial(var);
 }
 
-ex power::coeff(symbol const & s, int const n) const
+int power::degree(const ex & s) const
 {
-    if ((*basis.bp).compare(s)!=0) {
-        // basis not equal to s
-        if (n==0) {
-            return *this;
-        } else {
-            return exZERO();
-        }
-    } else if (is_exactly_of_type(*exponent.bp,numeric)&&
-               (static_cast<numeric const &>(*exponent.bp).compare(numeric(n))==0)) {
-        return exONE();
-    }
+       if (is_equal(ex_to<basic>(s)))
+               return 1;
+       else if (is_exactly_a<numeric>(exponent) && ex_to<numeric>(exponent).is_integer()) {
+               if (basis.is_equal(s))
+                       return ex_to<numeric>(exponent).to_int();
+               else
+                       return basis.degree(s) * ex_to<numeric>(exponent).to_int();
+       } else if (basis.has(s))
+               throw(std::runtime_error("power::degree(): undefined degree because of non-integer exponent"));
+       else
+               return 0;
+}
 
-    return exZERO();
+int power::ldegree(const ex & s) const 
+{
+       if (is_equal(ex_to<basic>(s)))
+               return 1;
+       else if (is_exactly_a<numeric>(exponent) && ex_to<numeric>(exponent).is_integer()) {
+               if (basis.is_equal(s))
+                       return ex_to<numeric>(exponent).to_int();
+               else
+                       return basis.ldegree(s) * ex_to<numeric>(exponent).to_int();
+       } else if (basis.has(s))
+               throw(std::runtime_error("power::ldegree(): undefined degree because of non-integer exponent"));
+       else
+               return 0;
 }
 
+ex power::coeff(const ex & s, int n) const
+{
+       if (is_equal(ex_to<basic>(s)))
+               return n==1 ? _ex1 : _ex0;
+       else if (!basis.is_equal(s)) {
+               // basis not equal to s
+               if (n == 0)
+                       return *this;
+               else
+                       return _ex0;
+       } else {
+               // basis equal to s
+               if (is_exactly_a<numeric>(exponent) && ex_to<numeric>(exponent).is_integer()) {
+                       // integer exponent
+                       int int_exp = ex_to<numeric>(exponent).to_int();
+                       if (n == int_exp)
+                               return _ex1;
+                       else
+                               return _ex0;
+               } else {
+                       // non-integer exponents are treated as zero
+                       if (n == 0)
+                               return *this;
+                       else
+                               return _ex0;
+               }
+       }
+}
+
+/** Perform automatic term rewriting rules in this class.  In the following
+ *  x, x1, x2,... stand for a symbolic variables of type ex and c, c1, c2...
+ *  stand for such expressions that contain a plain number.
+ *  - ^(x,0) -> 1  (also handles ^(0,0))
+ *  - ^(x,1) -> x
+ *  - ^(0,c) -> 0 or exception  (depending on the real part of c)
+ *  - ^(1,x) -> 1
+ *  - ^(c1,c2) -> *(c1^n,c1^(c2-n))  (so that 0<(c2-n)<1, try to evaluate roots, possibly in numerator and denominator of c1)
+ *  - ^(^(x,c1),c2) -> ^(x,c1*c2)  (c2 integer or -1 < c1 <= 1, case c1=1 should not happen, see below!)
+ *  - ^(*(x,y,z),c) -> *(x^c,y^c,z^c)  (if c integer)
+ *  - ^(*(x,c1),c2) -> ^(x,c2)*c1^c2  (c1>0)
+ *  - ^(*(x,c1),c2) -> ^(-x,c2)*c1^c2  (c1<0)
+ *
+ *  @param level cut-off in recursive evaluation */
 ex power::eval(int level) const
 {
-    // simplifications: ^(x,0) -> 1 (0^0 handled here)
-    //                  ^(x,1) -> x
-    //                  ^(0,x) -> 0 (except if x is real and negative, in which case an exception is thrown)
-    //                  ^(1,x) -> 1
-    //                  ^(c1,c2) -> *(c1^n,c1^(c2-n)) (c1, c2 numeric(), 0<(c2-n)<1 except if c1,c2 are rational, but c1^c2 is not)
-    //                  ^(^(x,c1),c2) -> ^(x,c1*c2) (c1, c2 numeric(), c2 integer or -1 < c1 <= 1, case c1=1 should not happen, see below!)
-    //                  ^(*(x,y,z),c1) -> *(x^c1,y^c1,z^c1) (c1 integer)
-    //                  ^(*(x,c1),c2) -> ^(x,c2)*c1^c2 (c1, c2 numeric(), c1>0)
-    //                  ^(*(x,c1),c2) -> ^(-x,c2)*c1^c2 (c1, c2 numeric(), c1<0)
-    
-    debugmsg("power eval",LOGLEVEL_MEMBER_FUNCTION);
-
-    if ((level==1)&&(flags & status_flags::evaluated)) {
-        return *this;
-    } else if (level == -max_recursion_level) {
-        throw(std::runtime_error("max recursion level reached"));
-    }
-    
-    ex const & ebasis    = level==1 ? basis    : basis.eval(level-1);
-    ex const & eexponent = level==1 ? exponent : exponent.eval(level-1);
-
-    bool basis_is_numerical=0;
-    bool exponent_is_numerical=0;
-    numeric * num_basis;
-    numeric * num_exponent;
-
-    if (is_exactly_of_type(*ebasis.bp,numeric)) {
-        basis_is_numerical=1;
-        num_basis=static_cast<numeric *>(ebasis.bp);
-    }
-    if (is_exactly_of_type(*eexponent.bp,numeric)) {
-        exponent_is_numerical=1;
-        num_exponent=static_cast<numeric *>(eexponent.bp);
-    }
-
-    // ^(x,0) -> 1 (0^0 also handled here)
-    if (eexponent.is_zero())
-        return exONE();
-
-    // ^(x,1) -> x
-    if (eexponent.is_equal(exONE()))
-        return ebasis;
-
-    // ^(0,x) -> 0 (except if x is real and negative)
-    if (ebasis.is_zero()) {
-        if (exponent_is_numerical && num_exponent->is_negative()) {
-            throw(std::overflow_error("power::eval(): division by zero"));
-        } else
-            return exZERO();
-    }
-
-    // ^(1,x) -> 1
-    if (ebasis.is_equal(exONE()))
-        return exONE();
-
-    if (basis_is_numerical && exponent_is_numerical) {
-        // ^(c1,c2) -> c1^c2 (c1, c2 numeric(),
-        // except if c1,c2 are rational, but c1^c2 is not)
-        bool basis_is_rational = num_basis->is_rational();
-        bool exponent_is_rational = num_exponent->is_rational();
-        numeric res = (*num_basis).power(*num_exponent);
-        
-        if ((!basis_is_rational || !exponent_is_rational)
-            || res.is_rational()) {
-            return res;
-        }
-        GINAC_ASSERT(!num_exponent->is_integer());  // has been handled by now
-        // ^(c1,n/m) -> *(c1^q,c1^(n/m-q)), 0<(n/m-h)<1, q integer
-        if (basis_is_rational && exponent_is_rational
-            && num_exponent->is_real()
-            && !num_exponent->is_integer()) {
-            numeric r, q, n, m;
-            n = num_exponent->numer();
-            m = num_exponent->denom();
-            q = iquo(n, m, r);
-            if (r.is_negative()) {
-                r = r.add(m);
-                q = q.sub(numONE());
-            }
-            if (q.is_zero())  // the exponent was in the allowed range 0<(n/m)<1
-                return this->hold();
-            else {
-                epvector res(2);
-                res.push_back(expair(ebasis,r.div(m)));
-                res.push_back(expair(ex(num_basis->power(q)),exONE()));
-                return (new mul(res))->setflag(status_flags::dynallocated | status_flags::evaluated);
-                /*return mul(num_basis->power(q),
-                           power(ex(*num_basis),ex(r.div(m)))).hold();
-                */
-                /* return (new mul(num_basis->power(q),
-                   power(*num_basis,r.div(m)).hold()))->setflag(status_flags::dynallocated | status_flags::evaluated);
-                */
-            }
-        }
-    }
-
-    // ^(^(x,c1),c2) -> ^(x,c1*c2)
-    // (c1, c2 numeric(), c2 integer or -1 < c1 <= 1,
-    // case c1=1 should not happen, see below!)
-    if (exponent_is_numerical && is_ex_exactly_of_type(ebasis,power)) {
-        power const & sub_power=ex_to_power(ebasis);
-        ex const & sub_basis=sub_power.basis;
-        ex const & sub_exponent=sub_power.exponent;
-        if (is_ex_exactly_of_type(sub_exponent,numeric)) {
-            numeric const & num_sub_exponent=ex_to_numeric(sub_exponent);
-            GINAC_ASSERT(num_sub_exponent!=numeric(1));
-            if (num_exponent->is_integer() || abs(num_sub_exponent)<1) {
-                return power(sub_basis,num_sub_exponent.mul(*num_exponent));
-            }
-        }
-    }
-    
-    // ^(*(x,y,z),c1) -> *(x^c1,y^c1,z^c1) (c1 integer)
-    if (exponent_is_numerical && num_exponent->is_integer() &&
-        is_ex_exactly_of_type(ebasis,mul)) {
-        return expand_mul(ex_to_mul(ebasis), *num_exponent);
-    }
-
-    // ^(*(...,x;c1),c2) -> ^(*(...,x;1),c2)*c1^c2 (c1, c2 numeric(), c1>0)
-    // ^(*(...,x,c1),c2) -> ^(*(...,x;-1),c2)*(-c1)^c2 (c1, c2 numeric(), c1<0)
-    if (exponent_is_numerical && is_ex_exactly_of_type(ebasis,mul)) {
-        GINAC_ASSERT(!num_exponent->is_integer()); // should have been handled above
-        mul const & mulref=ex_to_mul(ebasis);
-        if (!mulref.overall_coeff.is_equal(exONE())) {
-            numeric const & num_coeff=ex_to_numeric(mulref.overall_coeff);
-            if (num_coeff.is_real()) {
-                if (num_coeff.is_positive()>0) {
-                    mul * mulp=new mul(mulref);
-                    mulp->overall_coeff=exONE();
-                    mulp->clearflag(status_flags::evaluated);
-                    mulp->clearflag(status_flags::hash_calculated);
-                    return (new mul(power(*mulp,exponent),
-                                    power(num_coeff,*num_exponent)))->
-                        setflag(status_flags::dynallocated);
-                } else {
-                    GINAC_ASSERT(num_coeff.compare(numZERO())<0);
-                    if (num_coeff.compare(numMINUSONE())!=0) {
-                        mul * mulp=new mul(mulref);
-                        mulp->overall_coeff=exMINUSONE();
-                        mulp->clearflag(status_flags::evaluated);
-                        mulp->clearflag(status_flags::hash_calculated);
-                        return (new mul(power(*mulp,exponent),
-                                        power(abs(num_coeff),*num_exponent)))->
-                            setflag(status_flags::dynallocated);
-                    }
-                }
-            }
-        }
-    }
-        
-    if (are_ex_trivially_equal(ebasis,basis) &&
-        are_ex_trivially_equal(eexponent,exponent)) {
-        return this->hold();
-    }
-    return (new power(ebasis, eexponent))->setflag(status_flags::dynallocated |
-                                                   status_flags::evaluated);
+       if ((level==1) && (flags & status_flags::evaluated))
+               return *this;
+       else if (level == -max_recursion_level)
+               throw(std::runtime_error("max recursion level reached"));
+       
+       const ex & ebasis    = level==1 ? basis    : basis.eval(level-1);
+       const ex & eexponent = level==1 ? exponent : exponent.eval(level-1);
+       
+       bool basis_is_numerical = false;
+       bool exponent_is_numerical = false;
+       const numeric *num_basis;
+       const numeric *num_exponent;
+       
+       if (is_exactly_a<numeric>(ebasis)) {
+               basis_is_numerical = true;
+               num_basis = &ex_to<numeric>(ebasis);
+       }
+       if (is_exactly_a<numeric>(eexponent)) {
+               exponent_is_numerical = true;
+               num_exponent = &ex_to<numeric>(eexponent);
+       }
+       
+       // ^(x,0) -> 1  (0^0 also handled here)
+       if (eexponent.is_zero()) {
+               if (ebasis.is_zero())
+                       throw (std::domain_error("power::eval(): pow(0,0) is undefined"));
+               else
+                       return _ex1;
+       }
+       
+       // ^(x,1) -> x
+       if (eexponent.is_equal(_ex1))
+               return ebasis;
+
+       // ^(0,c1) -> 0 or exception  (depending on real value of c1)
+       if (ebasis.is_zero() && exponent_is_numerical) {
+               if ((num_exponent->real()).is_zero())
+                       throw (std::domain_error("power::eval(): pow(0,I) is undefined"));
+               else if ((num_exponent->real()).is_negative())
+                       throw (pole_error("power::eval(): division by zero",1));
+               else
+                       return _ex0;
+       }
+
+       // ^(1,x) -> 1
+       if (ebasis.is_equal(_ex1))
+               return _ex1;
+
+       // power of a function calculated by separate rules defined for this function
+       if (is_a<function>(ebasis))
+               return ex_to<function>(ebasis).power_law(eexponent);
+
+       if (exponent_is_numerical) {
+
+               // ^(c1,c2) -> c1^c2  (c1, c2 numeric(),
+               // except if c1,c2 are rational, but c1^c2 is not)
+               if (basis_is_numerical) {
+                       const bool basis_is_crational = num_basis->is_crational();
+                       const bool exponent_is_crational = num_exponent->is_crational();
+                       if (!basis_is_crational || !exponent_is_crational) {
+                               // return a plain float
+                               return (new numeric(num_basis->power(*num_exponent)))->setflag(status_flags::dynallocated |
+                                                                                              status_flags::evaluated |
+                                                                                              status_flags::expanded);
+                       }
+
+                       const numeric res = num_basis->power(*num_exponent);
+                       if (res.is_crational()) {
+                               return res;
+                       }
+                       GINAC_ASSERT(!num_exponent->is_integer());  // has been handled by now
+
+                       // ^(c1,n/m) -> *(c1^q,c1^(n/m-q)), 0<(n/m-q)<1, q integer
+                       if (basis_is_crational && exponent_is_crational
+                           && num_exponent->is_real()
+                           && !num_exponent->is_integer()) {
+                               const numeric n = num_exponent->numer();
+                               const numeric m = num_exponent->denom();
+                               numeric r;
+                               numeric q = iquo(n, m, r);
+                               if (r.is_negative()) {
+                                       r += m;
+                                       --q;
+                               }
+                               if (q.is_zero()) {  // the exponent was in the allowed range 0<(n/m)<1
+                                       if (num_basis->is_rational() && !num_basis->is_integer()) {
+                                               // try it for numerator and denominator separately, in order to
+                                               // partially simplify things like (5/8)^(1/3) -> 1/2*5^(1/3)
+                                               const numeric bnum = num_basis->numer();
+                                               const numeric bden = num_basis->denom();
+                                               const numeric res_bnum = bnum.power(*num_exponent);
+                                               const numeric res_bden = bden.power(*num_exponent);
+                                               if (res_bnum.is_integer())
+                                                       return (new mul(power(bden,-*num_exponent),res_bnum))->setflag(status_flags::dynallocated | status_flags::evaluated);
+                                               if (res_bden.is_integer())
+                                                       return (new mul(power(bnum,*num_exponent),res_bden.inverse()))->setflag(status_flags::dynallocated | status_flags::evaluated);
+                                       }
+                                       return this->hold();
+                               } else {
+                                       // assemble resulting product, but allowing for a re-evaluation,
+                                       // because otherwise we'll end up with something like
+                                       //    (7/8)^(4/3)  ->  7/8*(1/2*7^(1/3))
+                                       // instead of 7/16*7^(1/3).
+                                       ex prod = power(*num_basis,r.div(m));
+                                       return prod*power(*num_basis,q);
+                               }
+                       }
+               }
+       
+               // ^(^(x,c1),c2) -> ^(x,c1*c2)
+               // (c1, c2 numeric(), c2 integer or -1 < c1 <= 1,
+               // case c1==1 should not happen, see below!)
+               if (is_exactly_a<power>(ebasis)) {
+                       const power & sub_power = ex_to<power>(ebasis);
+                       const ex & sub_basis = sub_power.basis;
+                       const ex & sub_exponent = sub_power.exponent;
+                       if (is_exactly_a<numeric>(sub_exponent)) {
+                               const numeric & num_sub_exponent = ex_to<numeric>(sub_exponent);
+                               GINAC_ASSERT(num_sub_exponent!=numeric(1));
+                               if (num_exponent->is_integer() || (abs(num_sub_exponent) - (*_num1_p)).is_negative())
+                                       return power(sub_basis,num_sub_exponent.mul(*num_exponent));
+                       }
+               }
+       
+               // ^(*(x,y,z),c1) -> *(x^c1,y^c1,z^c1) (c1 integer)
+               if (num_exponent->is_integer() && is_exactly_a<mul>(ebasis)) {
+                       return expand_mul(ex_to<mul>(ebasis), *num_exponent, 0);
+               }
+       
+               // ^(*(...,x;c1),c2) -> *(^(*(...,x;1),c2),c1^c2)  (c1, c2 numeric(), c1>0)
+               // ^(*(...,x;c1),c2) -> *(^(*(...,x;-1),c2),(-c1)^c2)  (c1, c2 numeric(), c1<0)
+               if (is_exactly_a<mul>(ebasis)) {
+                       GINAC_ASSERT(!num_exponent->is_integer()); // should have been handled above
+                       const mul & mulref = ex_to<mul>(ebasis);
+                       if (!mulref.overall_coeff.is_equal(_ex1)) {
+                               const numeric & num_coeff = ex_to<numeric>(mulref.overall_coeff);
+                               if (num_coeff.is_real()) {
+                                       if (num_coeff.is_positive()) {
+                                               mul *mulp = new mul(mulref);
+                                               mulp->overall_coeff = _ex1;
+                                               mulp->clearflag(status_flags::evaluated);
+                                               mulp->clearflag(status_flags::hash_calculated);
+                                               return (new mul(power(*mulp,exponent),
+                                                               power(num_coeff,*num_exponent)))->setflag(status_flags::dynallocated);
+                                       } else {
+                                               GINAC_ASSERT(num_coeff.compare(*_num0_p)<0);
+                                               if (!num_coeff.is_equal(*_num_1_p)) {
+                                                       mul *mulp = new mul(mulref);
+                                                       mulp->overall_coeff = _ex_1;
+                                                       mulp->clearflag(status_flags::evaluated);
+                                                       mulp->clearflag(status_flags::hash_calculated);
+                                                       return (new mul(power(*mulp,exponent),
+                                                                       power(abs(num_coeff),*num_exponent)))->setflag(status_flags::dynallocated);
+                                               }
+                                       }
+                               }
+                       }
+               }
+
+               // ^(nc,c1) -> ncmul(nc,nc,...) (c1 positive integer, unless nc is a matrix)
+               if (num_exponent->is_pos_integer() &&
+                   ebasis.return_type() != return_types::commutative &&
+                   !is_a<matrix>(ebasis)) {
+                       return ncmul(exvector(num_exponent->to_int(), ebasis), true);
+               }
+       }
+       
+       if (are_ex_trivially_equal(ebasis,basis) &&
+           are_ex_trivially_equal(eexponent,exponent)) {
+               return this->hold();
+       }
+       return (new power(ebasis, eexponent))->setflag(status_flags::dynallocated |
+                                                      status_flags::evaluated);
 }
 
 ex power::evalf(int level) const
 {
-    debugmsg("power evalf",LOGLEVEL_MEMBER_FUNCTION);
-
-    ex ebasis;
-    ex eexponent;
-    
-    if (level==1) {
-        ebasis=basis;
-        eexponent=exponent;
-    } else if (level == -max_recursion_level) {
-        throw(std::runtime_error("max recursion level reached"));
-    } else {
-        ebasis=basis.evalf(level-1);
-        eexponent=exponent.evalf(level-1);
-    }
+       ex ebasis;
+       ex eexponent;
+       
+       if (level==1) {
+               ebasis = basis;
+               eexponent = exponent;
+       } else if (level == -max_recursion_level) {
+               throw(std::runtime_error("max recursion level reached"));
+       } else {
+               ebasis = basis.evalf(level-1);
+               if (!is_exactly_a<numeric>(exponent))
+                       eexponent = exponent.evalf(level-1);
+               else
+                       eexponent = exponent;
+       }
+
+       return power(ebasis,eexponent);
+}
 
-    return power(ebasis,eexponent);
+ex power::evalm() const
+{
+       const ex ebasis = basis.evalm();
+       const ex eexponent = exponent.evalm();
+       if (is_a<matrix>(ebasis)) {
+               if (is_exactly_a<numeric>(eexponent)) {
+                       return (new matrix(ex_to<matrix>(ebasis).pow(eexponent)))->setflag(status_flags::dynallocated);
+               }
+       }
+       return (new power(ebasis, eexponent))->setflag(status_flags::dynallocated);
 }
 
-ex power::subs(lst const & ls, lst const & lr) const
+bool power::has(const ex & other, unsigned options) const
 {
-    ex const & subsed_basis=basis.subs(ls,lr);
-    ex const & subsed_exponent=exponent.subs(ls,lr);
+       if (!(options & has_options::algebraic))
+               return basic::has(other, options);
+       if (!is_a<power>(other))
+               return basic::has(other, options);
+       if (!exponent.info(info_flags::integer)
+                       || !other.op(1).info(info_flags::integer))
+               return basic::has(other, options);
+       if (exponent.info(info_flags::posint)
+                       && other.op(1).info(info_flags::posint)
+                       && ex_to<numeric>(exponent).to_int()
+                                       > ex_to<numeric>(other.op(1)).to_int()
+                       && basis.match(other.op(0)))
+               return true;
+       if (exponent.info(info_flags::negint)
+                       && other.op(1).info(info_flags::negint)
+                       && ex_to<numeric>(exponent).to_int()
+                                       < ex_to<numeric>(other.op(1)).to_int()
+                       && basis.match(other.op(0)))
+               return true;
+       return basic::has(other, options);
+}
+
+// from mul.cpp
+extern bool tryfactsubs(const ex &, const ex &, int &, lst &);
+
+ex power::subs(const exmap & m, unsigned options) const
+{      
+       const ex &subsed_basis = basis.subs(m, options);
+       const ex &subsed_exponent = exponent.subs(m, options);
+
+       if (!are_ex_trivially_equal(basis, subsed_basis)
+        || !are_ex_trivially_equal(exponent, subsed_exponent)) 
+               return power(subsed_basis, subsed_exponent).subs_one_level(m, options);
 
-    if (are_ex_trivially_equal(basis,subsed_basis)&&
-        are_ex_trivially_equal(exponent,subsed_exponent)) {
-        return *this;
-    }
-    
-    return power(subsed_basis, subsed_exponent);
+       if (!(options & subs_options::algebraic))
+               return subs_one_level(m, options);
+
+       for (exmap::const_iterator it = m.begin(); it != m.end(); ++it) {
+               int nummatches = std::numeric_limits<int>::max();
+               lst repls;
+               if (tryfactsubs(*this, it->first, nummatches, repls))
+                       return (ex_to<basic>((*this) * power(it->second.subs(ex(repls), subs_options::no_pattern) / it->first.subs(ex(repls), subs_options::no_pattern), nummatches))).subs_one_level(m, options);
+       }
+
+       return subs_one_level(m, options);
+}
+
+ex power::eval_ncmul(const exvector & v) const
+{
+       return inherited::eval_ncmul(v);
 }
 
-ex power::simplify_ncmul(exvector const & v) const
+ex power::conjugate() const
 {
-    return basic::simplify_ncmul(v);
+       ex newbasis = basis.conjugate();
+       ex newexponent = exponent.conjugate();
+       if (are_ex_trivially_equal(basis, newbasis) && are_ex_trivially_equal(exponent, newexponent)) {
+               return *this;
+       }
+       return (new power(newbasis, newexponent))->setflag(status_flags::dynallocated);
 }
 
 // protected
 
-int power::compare_same_type(basic const & other) const
+/** Implementation of ex::diff() for a power.
+ *  @see ex::diff */
+ex power::derivative(const symbol & s) const
 {
-    GINAC_ASSERT(is_exactly_of_type(other, power));
-    power const & o=static_cast<power const &>(const_cast<basic &>(other));
+       if (is_a<numeric>(exponent)) {
+               // D(b^r) = r * b^(r-1) * D(b) (faster than the formula below)
+               epvector newseq;
+               newseq.reserve(2);
+               newseq.push_back(expair(basis, exponent - _ex1));
+               newseq.push_back(expair(basis.diff(s), _ex1));
+               return mul(newseq, exponent);
+       } else {
+               // D(b^e) = b^e * (D(e)*ln(b) + e*D(b)/b)
+               return mul(*this,
+                          add(mul(exponent.diff(s), log(basis)),
+                          mul(mul(exponent, basis.diff(s)), power(basis, _ex_1))));
+       }
+}
 
-    int cmpval;
-    cmpval=basis.compare(o.basis);
-    if (cmpval==0) {
-        return exponent.compare(o.exponent);
-    }
-    return cmpval;
+int power::compare_same_type(const basic & other) const
+{
+       GINAC_ASSERT(is_exactly_a<power>(other));
+       const power &o = static_cast<const power &>(other);
+
+       int cmpval = basis.compare(o.basis);
+       if (cmpval)
+               return cmpval;
+       else
+               return exponent.compare(o.exponent);
 }
 
-unsigned power::return_type(void) const
+unsigned power::return_type() const
 {
-    return basis.return_type();
+       return basis.return_type();
 }
-   
-unsigned power::return_type_tinfo(void) const
+
+tinfo_t power::return_type_tinfo() const
 {
-    return basis.return_type_tinfo();
+       return basis.return_type_tinfo();
 }
 
 ex power::expand(unsigned options) const
 {
-    ex expanded_basis=basis.expand(options);
-
-    if (!is_ex_exactly_of_type(exponent,numeric)||
-        !ex_to_numeric(exponent).is_integer()) {
-        if (are_ex_trivially_equal(basis,expanded_basis)) {
-            return this->hold();
-        } else {
-            return (new power(expanded_basis,exponent))->
-                    setflag(status_flags::dynallocated);
-        }
-    }
-
-    // integer numeric exponent
-    numeric const & num_exponent=ex_to_numeric(exponent);
-    int int_exponent = num_exponent.to_int();
-
-    if (int_exponent > 0 && is_ex_exactly_of_type(expanded_basis,add)) {
-        return expand_add(ex_to_add(expanded_basis), int_exponent);
-    }
-
-    if (is_ex_exactly_of_type(expanded_basis,mul)) {
-        return expand_mul(ex_to_mul(expanded_basis), num_exponent);
-    }
-
-    // cannot expand further
-    if (are_ex_trivially_equal(basis,expanded_basis)) {
-        return this->hold();
-    } else {
-        return (new power(expanded_basis,exponent))->
-               setflag(status_flags::dynallocated);
-    }
+       if (options == 0 && (flags & status_flags::expanded))
+               return *this;
+       
+       const ex expanded_basis = basis.expand(options);
+       const ex expanded_exponent = exponent.expand(options);
+       
+       // x^(a+b) -> x^a * x^b
+       if (is_exactly_a<add>(expanded_exponent)) {
+               const add &a = ex_to<add>(expanded_exponent);
+               exvector distrseq;
+               distrseq.reserve(a.seq.size() + 1);
+               epvector::const_iterator last = a.seq.end();
+               epvector::const_iterator cit = a.seq.begin();
+               while (cit!=last) {
+                       distrseq.push_back(power(expanded_basis, a.recombine_pair_to_ex(*cit)));
+                       ++cit;
+               }
+               
+               // Make sure that e.g. (x+y)^(2+a) expands the (x+y)^2 factor
+               if (ex_to<numeric>(a.overall_coeff).is_integer()) {
+                       const numeric &num_exponent = ex_to<numeric>(a.overall_coeff);
+                       int int_exponent = num_exponent.to_int();
+                       if (int_exponent > 0 && is_exactly_a<add>(expanded_basis))
+                               distrseq.push_back(expand_add(ex_to<add>(expanded_basis), int_exponent, options));
+                       else
+                               distrseq.push_back(power(expanded_basis, a.overall_coeff));
+               } else
+                       distrseq.push_back(power(expanded_basis, a.overall_coeff));
+               
+               // Make sure that e.g. (x+y)^(1+a) -> x*(x+y)^a + y*(x+y)^a
+               ex r = (new mul(distrseq))->setflag(status_flags::dynallocated);
+               return r.expand(options);
+       }
+       
+       if (!is_exactly_a<numeric>(expanded_exponent) ||
+               !ex_to<numeric>(expanded_exponent).is_integer()) {
+               if (are_ex_trivially_equal(basis,expanded_basis) && are_ex_trivially_equal(exponent,expanded_exponent)) {
+                       return this->hold();
+               } else {
+                       return (new power(expanded_basis,expanded_exponent))->setflag(status_flags::dynallocated | (options == 0 ? status_flags::expanded : 0));
+               }
+       }
+       
+       // integer numeric exponent
+       const numeric & num_exponent = ex_to<numeric>(expanded_exponent);
+       int int_exponent = num_exponent.to_int();
+       
+       // (x+y)^n, n>0
+       if (int_exponent > 0 && is_exactly_a<add>(expanded_basis))
+               return expand_add(ex_to<add>(expanded_basis), int_exponent, options);
+       
+       // (x*y)^n -> x^n * y^n
+       if (is_exactly_a<mul>(expanded_basis))
+               return expand_mul(ex_to<mul>(expanded_basis), num_exponent, options, true);
+       
+       // cannot expand further
+       if (are_ex_trivially_equal(basis,expanded_basis) && are_ex_trivially_equal(exponent,expanded_exponent))
+               return this->hold();
+       else
+               return (new power(expanded_basis,expanded_exponent))->setflag(status_flags::dynallocated | (options == 0 ? status_flags::expanded : 0));
 }
 
 //////////
@@ -445,280 +731,209 @@ ex power::expand(unsigned options) const
 // non-virtual functions in this class
 //////////
 
-ex power::expand_add(add const & a, int const n) const
+/** expand a^n where a is an add and n is a positive integer.
+ *  @see power::expand */
+ex power::expand_add(const add & a, int n, unsigned options) const
 {
-    // expand a^n where a is an add and n is an integer
-
-    if (n==2) {
-        return expand_add_2(a);
-    }
-    
-    int m=a.nops();
-    exvector sum;
-    sum.reserve((n+1)*(m-1));
-    intvector k(m-1);
-    intvector k_cum(m-1); // k_cum[l]:=sum(i=0,l,k[l]);
-    intvector upper_limit(m-1);
-    int l;
-    
-    for (int l=0; l<m-1; l++) {
-        k[l]=0;
-        k_cum[l]=0;
-        upper_limit[l]=n;
-    }
-
-    while (1) {
-        exvector term;
-        term.reserve(m+1);
-        for (l=0; l<m-1; l++) {
-            ex const & b=a.op(l);
-            GINAC_ASSERT(!is_ex_exactly_of_type(b,add));
-            GINAC_ASSERT(!is_ex_exactly_of_type(b,power)||
-                   !is_ex_exactly_of_type(ex_to_power(b).exponent,numeric)||
-                   !ex_to_numeric(ex_to_power(b).exponent).is_pos_integer());
-            if (is_ex_exactly_of_type(b,mul)) {
-                term.push_back(expand_mul(ex_to_mul(b),numeric(k[l])));
-            } else {
-                term.push_back(power(b,k[l]));
-            }
-        }
-
-        ex const & b=a.op(l);
-        GINAC_ASSERT(!is_ex_exactly_of_type(b,add));
-        GINAC_ASSERT(!is_ex_exactly_of_type(b,power)||
-               !is_ex_exactly_of_type(ex_to_power(b).exponent,numeric)||
-               !ex_to_numeric(ex_to_power(b).exponent).is_pos_integer());
-        if (is_ex_exactly_of_type(b,mul)) {
-            term.push_back(expand_mul(ex_to_mul(b),numeric(n-k_cum[m-2])));
-        } else {
-            term.push_back(power(b,n-k_cum[m-2]));
-        }
-
-        numeric f=binomial(numeric(n),numeric(k[0]));
-        for (l=1; l<m-1; l++) {
-            f=f*binomial(numeric(n-k_cum[l-1]),numeric(k[l]));
-        }
-        term.push_back(f);
-
-        /*
-        cout << "begin term" << endl;
-        for (int i=0; i<m-1; i++) {
-            cout << "k[" << i << "]=" << k[i] << endl;
-            cout << "k_cum[" << i << "]=" << k_cum[i] << endl;
-            cout << "upper_limit[" << i << "]=" << upper_limit[i] << endl;
-        }
-        for (exvector::const_iterator cit=term.begin(); cit!=term.end(); ++cit) {
-            cout << *cit << endl;
-        }
-        cout << "end term" << endl;
-        */
-
-        // TODO: optimize this
-        sum.push_back((new mul(term))->setflag(status_flags::dynallocated));
-        
-        // increment k[]
-        l=m-2;
-        while ((l>=0)&&((++k[l])>upper_limit[l])) {
-            k[l]=0;    
-            l--;
-        }
-        if (l<0) break;
-
-        // recalc k_cum[] and upper_limit[]
-        if (l==0) {
-            k_cum[0]=k[0];
-        } else {
-            k_cum[l]=k_cum[l-1]+k[l];
-        }
-        for (int i=l+1; i<m-1; i++) {
-            k_cum[i]=k_cum[i-1]+k[i];
-        }
-
-        for (int i=l+1; i<m-1; i++) {
-            upper_limit[i]=n-k_cum[i-1];
-        }   
-    }
-    return (new add(sum))->setflag(status_flags::dynallocated);
+       if (n==2)
+               return expand_add_2(a, options);
+
+       const size_t m = a.nops();
+       exvector result;
+       // The number of terms will be the number of combinatorial compositions,
+       // i.e. the number of unordered arrangements of m nonnegative integers
+       // which sum up to n.  It is frequently written as C_n(m) and directly
+       // related with binomial coefficients:
+       result.reserve(binomial(numeric(n+m-1), numeric(m-1)).to_int());
+       intvector k(m-1);
+       intvector k_cum(m-1); // k_cum[l]:=sum(i=0,l,k[l]);
+       intvector upper_limit(m-1);
+       int l;
+
+       for (size_t l=0; l<m-1; ++l) {
+               k[l] = 0;
+               k_cum[l] = 0;
+               upper_limit[l] = n;
+       }
+
+       while (true) {
+               exvector term;
+               term.reserve(m+1);
+               for (l=0; l<m-1; ++l) {
+                       const ex & b = a.op(l);
+                       GINAC_ASSERT(!is_exactly_a<add>(b));
+                       GINAC_ASSERT(!is_exactly_a<power>(b) ||
+                                    !is_exactly_a<numeric>(ex_to<power>(b).exponent) ||
+                                    !ex_to<numeric>(ex_to<power>(b).exponent).is_pos_integer() ||
+                                    !is_exactly_a<add>(ex_to<power>(b).basis) ||
+                                    !is_exactly_a<mul>(ex_to<power>(b).basis) ||
+                                    !is_exactly_a<power>(ex_to<power>(b).basis));
+                       if (is_exactly_a<mul>(b))
+                               term.push_back(expand_mul(ex_to<mul>(b), numeric(k[l]), options, true));
+                       else
+                               term.push_back(power(b,k[l]));
+               }
+
+               const ex & b = a.op(l);
+               GINAC_ASSERT(!is_exactly_a<add>(b));
+               GINAC_ASSERT(!is_exactly_a<power>(b) ||
+                            !is_exactly_a<numeric>(ex_to<power>(b).exponent) ||
+                            !ex_to<numeric>(ex_to<power>(b).exponent).is_pos_integer() ||
+                            !is_exactly_a<add>(ex_to<power>(b).basis) ||
+                            !is_exactly_a<mul>(ex_to<power>(b).basis) ||
+                            !is_exactly_a<power>(ex_to<power>(b).basis));
+               if (is_exactly_a<mul>(b))
+                       term.push_back(expand_mul(ex_to<mul>(b), numeric(n-k_cum[m-2]), options, true));
+               else
+                       term.push_back(power(b,n-k_cum[m-2]));
+
+               numeric f = binomial(numeric(n),numeric(k[0]));
+               for (l=1; l<m-1; ++l)
+                       f *= binomial(numeric(n-k_cum[l-1]),numeric(k[l]));
+
+               term.push_back(f);
+
+               result.push_back(ex((new mul(term))->setflag(status_flags::dynallocated)).expand(options));
+
+               // increment k[]
+               l = m-2;
+               while ((l>=0) && ((++k[l])>upper_limit[l])) {
+                       k[l] = 0;
+                       --l;
+               }
+               if (l<0) break;
+
+               // recalc k_cum[] and upper_limit[]
+               k_cum[l] = (l==0 ? k[0] : k_cum[l-1]+k[l]);
+
+               for (size_t i=l+1; i<m-1; ++i)
+                       k_cum[i] = k_cum[i-1]+k[i];
+
+               for (size_t i=l+1; i<m-1; ++i)
+                       upper_limit[i] = n-k_cum[i-1];
+       }
+
+       return (new add(result))->setflag(status_flags::dynallocated |
+                                         status_flags::expanded);
 }
 
-/*
-ex power::expand_add_2(add const & a) const
-{
-    // special case: expand a^2 where a is an add
-
-    epvector sum;
-    sum.reserve((a.seq.size()*(a.seq.size()+1))/2);
-    epvector::const_iterator last=a.seq.end();
-
-    for (epvector::const_iterator cit0=a.seq.begin(); cit0!=last; ++cit0) {
-        ex const & b=a.recombine_pair_to_ex(*cit0);
-        GINAC_ASSERT(!is_ex_exactly_of_type(b,add));
-        GINAC_ASSERT(!is_ex_exactly_of_type(b,power)||
-               !is_ex_exactly_of_type(ex_to_power(b).exponent,numeric)||
-               !ex_to_numeric(ex_to_power(b).exponent).is_pos_integer());
-        if (is_ex_exactly_of_type(b,mul)) {
-            sum.push_back(a.split_ex_to_pair(expand_mul(ex_to_mul(b),numTWO())));
-        } else {
-            sum.push_back(a.split_ex_to_pair((new power(b,exTWO()))->
-                                              setflag(status_flags::dynallocated)));
-        }
-        for (epvector::const_iterator cit1=cit0+1; cit1!=last; ++cit1) {
-            sum.push_back(a.split_ex_to_pair((new mul(a.recombine_pair_to_ex(*cit0),
-                                                      a.recombine_pair_to_ex(*cit1)))->
-                                              setflag(status_flags::dynallocated),
-                                             exTWO()));
-        }
-    }
-
-    GINAC_ASSERT(sum.size()==(a.seq.size()*(a.seq.size()+1))/2);
-
-    return (new add(sum))->setflag(status_flags::dynallocated);
-}
-*/
-
-ex power::expand_add_2(add const & a) const
-{
-    // special case: expand a^2 where a is an add
-
-    epvector sum;
-    unsigned a_nops=a.nops();
-    sum.reserve((a_nops*(a_nops+1))/2);
-    epvector::const_iterator last=a.seq.end();
-
-    // power(+(x,...,z;c),2)=power(+(x,...,z;0),2)+2*c*+(x,...,z;0)+c*c
-    // first part: ignore overall_coeff and expand other terms
-    for (epvector::const_iterator cit0=a.seq.begin(); cit0!=last; ++cit0) {
-        ex const & r=(*cit0).rest;
-        ex const & c=(*cit0).coeff;
-        
-        GINAC_ASSERT(!is_ex_exactly_of_type(r,add));
-        GINAC_ASSERT(!is_ex_exactly_of_type(r,power)||
-               !is_ex_exactly_of_type(ex_to_power(r).exponent,numeric)||
-               !ex_to_numeric(ex_to_power(r).exponent).is_pos_integer()||
-               !is_ex_exactly_of_type(ex_to_power(r).basis,add)||
-               !is_ex_exactly_of_type(ex_to_power(r).basis,mul)||
-               !is_ex_exactly_of_type(ex_to_power(r).basis,power));
-
-        if (are_ex_trivially_equal(c,exONE())) {
-            if (is_ex_exactly_of_type(r,mul)) {
-                sum.push_back(expair(expand_mul(ex_to_mul(r),numTWO()),exONE()));
-            } else {
-                sum.push_back(expair((new power(r,exTWO()))->setflag(status_flags::dynallocated),
-                                     exONE()));
-            }
-        } else {
-            if (is_ex_exactly_of_type(r,mul)) {
-                sum.push_back(expair(expand_mul(ex_to_mul(r),numTWO()),
-                                     ex_to_numeric(c).power_dyn(numTWO())));
-            } else {
-                sum.push_back(expair((new power(r,exTWO()))->setflag(status_flags::dynallocated),
-                                     ex_to_numeric(c).power_dyn(numTWO())));
-            }
-        }
-            
-        for (epvector::const_iterator cit1=cit0+1; cit1!=last; ++cit1) {
-            ex const & r1=(*cit1).rest;
-            ex const & c1=(*cit1).coeff;
-            sum.push_back(a.combine_ex_with_coeff_to_pair((new mul(r,r1))->setflag(status_flags::dynallocated),
-                                                          numTWO().mul(ex_to_numeric(c)).mul_dyn(ex_to_numeric(c1))));
-        }
-    }
-
-    GINAC_ASSERT(sum.size()==(a.seq.size()*(a.seq.size()+1))/2);
-
-    // second part: add terms coming from overall_factor (if != 0)
-    if (!a.overall_coeff.is_equal(exZERO())) {
-        for (epvector::const_iterator cit=a.seq.begin(); cit!=a.seq.end(); ++cit) {
-            sum.push_back(a.combine_pair_with_coeff_to_pair(*cit,ex_to_numeric(a.overall_coeff).mul_dyn(numTWO())));
-        }
-        sum.push_back(expair(ex_to_numeric(a.overall_coeff).power_dyn(numTWO()),exONE()));
-    }
-        
-    GINAC_ASSERT(sum.size()==(a_nops*(a_nops+1))/2);
-    
-    return (new add(sum))->setflag(status_flags::dynallocated);
-}
-
-ex power::expand_mul(mul const & m, numeric const & n) const
-{
-    // expand m^n where m is a mul and n is and integer
-
-    if (n.is_equal(numZERO())) {
-        return exONE();
-    }
-    
-    epvector distrseq;
-    distrseq.reserve(m.seq.size());
-    epvector::const_iterator last=m.seq.end();
-    epvector::const_iterator cit=m.seq.begin();
-    while (cit!=last) {
-        if (is_ex_exactly_of_type((*cit).rest,numeric)) {
-            distrseq.push_back(m.combine_pair_with_coeff_to_pair(*cit,n));
-        } else {
-            // it is safe not to call mul::combine_pair_with_coeff_to_pair()
-            // since n is an integer
-            distrseq.push_back(expair((*cit).rest,
-                                      ex_to_numeric((*cit).coeff).mul(n)));
-        }
-        ++cit;
-    }
-    return (new mul(distrseq,ex_to_numeric(m.overall_coeff).power_dyn(n)))
-                 ->setflag(status_flags::dynallocated);
-}
 
-/*
-ex power::expand_commutative_3(ex const & basis, numeric const & exponent,
-                             unsigned options) const
+/** Special case of power::expand_add. Expands a^2 where a is an add.
+ *  @see power::expand_add */
+ex power::expand_add_2(const add & a, unsigned options) const
 {
-    // obsolete
-
-    exvector distrseq;
-    epvector splitseq;
-
-    add const & addref=static_cast<add const &>(*basis.bp);
-
-    splitseq=addref.seq;
-    splitseq.pop_back();
-    ex first_operands=add(splitseq);
-    ex last_operand=addref.recombine_pair_to_ex(*(addref.seq.end()-1));
-    
-    int n=exponent.to_int();
-    for (int k=0; k<=n; k++) {
-        distrseq.push_back(binomial(n,k)*power(first_operands,numeric(k))*
-                           power(last_operand,numeric(n-k)));
-    }
-    return ex((new add(distrseq))->setflag(status_flags::sub_expanded |
-                                           status_flags::expanded |
-                                           status_flags::dynallocated  )).
-           expand(options);
-}
-*/
+       epvector sum;
+       size_t a_nops = a.nops();
+       sum.reserve((a_nops*(a_nops+1))/2);
+       epvector::const_iterator last = a.seq.end();
+
+       // power(+(x,...,z;c),2)=power(+(x,...,z;0),2)+2*c*+(x,...,z;0)+c*c
+       // first part: ignore overall_coeff and expand other terms
+       for (epvector::const_iterator cit0=a.seq.begin(); cit0!=last; ++cit0) {
+               const ex & r = cit0->rest;
+               const ex & c = cit0->coeff;
+               
+               GINAC_ASSERT(!is_exactly_a<add>(r));
+               GINAC_ASSERT(!is_exactly_a<power>(r) ||
+                            !is_exactly_a<numeric>(ex_to<power>(r).exponent) ||
+                            !ex_to<numeric>(ex_to<power>(r).exponent).is_pos_integer() ||
+                            !is_exactly_a<add>(ex_to<power>(r).basis) ||
+                            !is_exactly_a<mul>(ex_to<power>(r).basis) ||
+                            !is_exactly_a<power>(ex_to<power>(r).basis));
+               
+               if (c.is_equal(_ex1)) {
+                       if (is_exactly_a<mul>(r)) {
+                               sum.push_back(expair(expand_mul(ex_to<mul>(r), *_num2_p, options, true),
+                                                    _ex1));
+                       } else {
+                               sum.push_back(expair((new power(r,_ex2))->setflag(status_flags::dynallocated),
+                                                    _ex1));
+                       }
+               } else {
+                       if (is_exactly_a<mul>(r)) {
+                               sum.push_back(a.combine_ex_with_coeff_to_pair(expand_mul(ex_to<mul>(r), *_num2_p, options, true),
+                                                    ex_to<numeric>(c).power_dyn(*_num2_p)));
+                       } else {
+                               sum.push_back(a.combine_ex_with_coeff_to_pair((new power(r,_ex2))->setflag(status_flags::dynallocated),
+                                                    ex_to<numeric>(c).power_dyn(*_num2_p)));
+                       }
+               }
+
+               for (epvector::const_iterator cit1=cit0+1; cit1!=last; ++cit1) {
+                       const ex & r1 = cit1->rest;
+                       const ex & c1 = cit1->coeff;
+                       sum.push_back(a.combine_ex_with_coeff_to_pair((new mul(r,r1))->setflag(status_flags::dynallocated),
+                                                                     _num2_p->mul(ex_to<numeric>(c)).mul_dyn(ex_to<numeric>(c1))));
+               }
+       }
+       
+       GINAC_ASSERT(sum.size()==(a.seq.size()*(a.seq.size()+1))/2);
+       
+       // second part: add terms coming from overall_factor (if != 0)
+       if (!a.overall_coeff.is_zero()) {
+               epvector::const_iterator i = a.seq.begin(), end = a.seq.end();
+               while (i != end) {
+                       sum.push_back(a.combine_pair_with_coeff_to_pair(*i, ex_to<numeric>(a.overall_coeff).mul_dyn(*_num2_p)));
+                       ++i;
+               }
+               sum.push_back(expair(ex_to<numeric>(a.overall_coeff).power_dyn(*_num2_p),_ex1));
+       }
+       
+       GINAC_ASSERT(sum.size()==(a_nops*(a_nops+1))/2);
+       
+       return (new add(sum))->setflag(status_flags::dynallocated | status_flags::expanded);
+}
 
-/*
-ex power::expand_noncommutative(ex const & basis, numeric const & exponent,
-                                unsigned options) const
+/** Expand factors of m in m^n where m is a mul and n is and integer.
+ *  @see power::expand */
+ex power::expand_mul(const mul & m, const numeric & n, unsigned options, bool from_expand) const
 {
-    ex rest_power=ex(power(basis,exponent.add(numMINUSONE()))).
-                  expand(options | expand_options::internal_do_not_expand_power_operands);
-
-    return ex(mul(rest_power,basis),0).
-           expand(options | expand_options::internal_do_not_expand_mul_operands);
+       GINAC_ASSERT(n.is_integer());
+
+       if (n.is_zero()) {
+               return _ex1;
+       }
+
+       // Leave it to multiplication since dummy indices have to be renamed
+       if (get_all_dummy_indices(m).size() > 0 && n.is_positive()) {
+               ex result = m;
+               exvector va = get_all_dummy_indices(m);
+               sort(va.begin(), va.end(), ex_is_less());
+
+               for (int i=1; i < n.to_int(); i++)
+                       result *= rename_dummy_indices_uniquely(va, m);
+               return result;
+       }
+
+       epvector distrseq;
+       distrseq.reserve(m.seq.size());
+       bool need_reexpand = false;
+
+       epvector::const_iterator last = m.seq.end();
+       epvector::const_iterator cit = m.seq.begin();
+       while (cit!=last) {
+               if (is_exactly_a<numeric>(cit->rest)) {
+                       distrseq.push_back(m.combine_pair_with_coeff_to_pair(*cit, n));
+               } else {
+                       // it is safe not to call mul::combine_pair_with_coeff_to_pair()
+                       // since n is an integer
+                       numeric new_coeff = ex_to<numeric>(cit->coeff).mul(n);
+                       if (from_expand && is_exactly_a<add>(cit->rest) && new_coeff.is_pos_integer()) {
+                               // this happens when e.g. (a+b)^(1/2) gets squared and
+                               // the resulting product needs to be reexpanded
+                               need_reexpand = true;
+                       }
+                       distrseq.push_back(expair(cit->rest, new_coeff));
+               }
+               ++cit;
+       }
+
+       const mul & result = static_cast<const mul &>((new mul(distrseq, ex_to<numeric>(m.overall_coeff).power_dyn(n)))->setflag(status_flags::dynallocated));
+       if (need_reexpand)
+               return ex(result).expand(options);
+       if (from_expand)
+               return result.setflag(status_flags::expanded);
+       return result;
 }
-*/
-
-//////////
-// static member variables
-//////////
-
-// protected
-
-unsigned power::precedence=60;
-
-//////////
-// global constants
-//////////
-
-const power some_power;
-type_info const & typeid_power=typeid(some_power);
 
 } // namespace GiNaC
diff --git a/ginac/pseries.cpp b/ginac/pseries.cpp
new file mode 100644 (file)
index 0000000..c5b8532
--- /dev/null
@@ -0,0 +1,1177 @@
+/** @file pseries.cpp
+ *
+ *  Implementation of class for extended truncated power series and
+ *  methods for series expansion. */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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 <numeric>
+#include <stdexcept>
+
+#include "pseries.h"
+#include "add.h"
+#include "inifcns.h" // for Order function
+#include "lst.h"
+#include "mul.h"
+#include "power.h"
+#include "relational.h"
+#include "operators.h"
+#include "symbol.h"
+#include "integral.h"
+#include "archive.h"
+#include "utils.h"
+
+namespace GiNaC {
+
+GINAC_IMPLEMENT_REGISTERED_CLASS_OPT(pseries, basic,
+  print_func<print_context>(&pseries::do_print).
+  print_func<print_latex>(&pseries::do_print_latex).
+  print_func<print_tree>(&pseries::do_print_tree).
+  print_func<print_python>(&pseries::do_print_python).
+  print_func<print_python_repr>(&pseries::do_print_python_repr))
+
+
+/*
+ *  Default constructor
+ */
+
+pseries::pseries() : inherited(&pseries::tinfo_static) { }
+
+
+/*
+ *  Other ctors
+ */
+
+/** Construct pseries from a vector of coefficients and powers.
+ *  expair.rest holds the coefficient, expair.coeff holds the power.
+ *  The powers must be integers (positive or negative) and in ascending order;
+ *  the last coefficient can be Order(_ex1) to represent a truncated,
+ *  non-terminating series.
+ *
+ *  @param rel_  expansion variable and point (must hold a relational)
+ *  @param ops_  vector of {coefficient, power} pairs (coefficient must not be zero)
+ *  @return newly constructed pseries */
+pseries::pseries(const ex &rel_, const epvector &ops_) : basic(&pseries::tinfo_static), seq(ops_)
+{
+       GINAC_ASSERT(is_a<relational>(rel_));
+       GINAC_ASSERT(is_a<symbol>(rel_.lhs()));
+       point = rel_.rhs();
+       var = rel_.lhs();
+}
+
+
+/*
+ *  Archiving
+ */
+
+pseries::pseries(const archive_node &n, lst &sym_lst) : inherited(n, sym_lst)
+{
+       for (unsigned int i=0; true; ++i) {
+               ex rest;
+               ex coeff;
+               if (n.find_ex("coeff", rest, sym_lst, i) && n.find_ex("power", coeff, sym_lst, i))
+                       seq.push_back(expair(rest, coeff));
+               else
+                       break;
+       }
+       n.find_ex("var", var, sym_lst);
+       n.find_ex("point", point, sym_lst);
+}
+
+void pseries::archive(archive_node &n) const
+{
+       inherited::archive(n);
+       epvector::const_iterator i = seq.begin(), iend = seq.end();
+       while (i != iend) {
+               n.add_ex("coeff", i->rest);
+               n.add_ex("power", i->coeff);
+               ++i;
+       }
+       n.add_ex("var", var);
+       n.add_ex("point", point);
+}
+
+DEFAULT_UNARCHIVE(pseries)
+
+//////////
+// functions overriding virtual functions from base classes
+//////////
+
+void pseries::print_series(const print_context & c, const char *openbrace, const char *closebrace, const char *mul_sym, const char *pow_sym, unsigned level) const
+{
+       if (precedence() <= level)
+               c.s << '(';
+               
+       // objects of type pseries must not have any zero entries, so the
+       // trivial (zero) pseries needs a special treatment here:
+       if (seq.empty())
+               c.s << '0';
+
+       epvector::const_iterator i = seq.begin(), end = seq.end();
+       while (i != end) {
+
+               // print a sign, if needed
+               if (i != seq.begin())
+                       c.s << '+';
+
+               if (!is_exactly_a<Order_function>(i->rest)) {
+
+                       // print 'rest', i.e. the expansion coefficient
+                       if (i->rest.info(info_flags::numeric) &&
+                               i->rest.info(info_flags::positive)) {
+                               i->rest.print(c);
+                       } else {
+                               c.s << openbrace << '(';
+                               i->rest.print(c);
+                               c.s << ')' << closebrace;
+                       }
+
+                       // print 'coeff', something like (x-1)^42
+                       if (!i->coeff.is_zero()) {
+                               c.s << mul_sym;
+                               if (!point.is_zero()) {
+                                       c.s << openbrace << '(';
+                                       (var-point).print(c);
+                                       c.s << ')' << closebrace;
+                               } else
+                                       var.print(c);
+                               if (i->coeff.compare(_ex1)) {
+                                       c.s << pow_sym;
+                                       c.s << openbrace;
+                                       if (i->coeff.info(info_flags::negative)) {
+                                               c.s << '(';
+                                               i->coeff.print(c);
+                                               c.s << ')';
+                                       } else
+                                               i->coeff.print(c);
+                                       c.s << closebrace;
+                               }
+                       }
+               } else
+                       Order(power(var-point,i->coeff)).print(c);
+               ++i;
+       }
+
+       if (precedence() <= level)
+               c.s << ')';
+}
+
+void pseries::do_print(const print_context & c, unsigned level) const
+{
+       print_series(c, "", "", "*", "^", level);
+}
+
+void pseries::do_print_latex(const print_latex & c, unsigned level) const
+{
+       print_series(c, "{", "}", " ", "^", level);
+}
+
+void pseries::do_print_python(const print_python & c, unsigned level) const
+{
+       print_series(c, "", "", "*", "**", level);
+}
+
+void pseries::do_print_tree(const print_tree & c, unsigned level) const
+{
+       c.s << std::string(level, ' ') << class_name() << " @" << this
+           << std::hex << ", hash=0x" << hashvalue << ", flags=0x" << flags << std::dec
+           << std::endl;
+       size_t num = seq.size();
+       for (size_t i=0; i<num; ++i) {
+               seq[i].rest.print(c, level + c.delta_indent);
+               seq[i].coeff.print(c, level + c.delta_indent);
+               c.s << std::string(level + c.delta_indent, ' ') << "-----" << std::endl;
+       }
+       var.print(c, level + c.delta_indent);
+       point.print(c, level + c.delta_indent);
+}
+
+void pseries::do_print_python_repr(const print_python_repr & c, unsigned level) const
+{
+       c.s << class_name() << "(relational(";
+       var.print(c);
+       c.s << ',';
+       point.print(c);
+       c.s << "),[";
+       size_t num = seq.size();
+       for (size_t i=0; i<num; ++i) {
+               if (i)
+                       c.s << ',';
+               c.s << '(';
+               seq[i].rest.print(c);
+               c.s << ',';
+               seq[i].coeff.print(c);
+               c.s << ')';
+       }
+       c.s << "])";
+}
+
+int pseries::compare_same_type(const basic & other) const
+{
+       GINAC_ASSERT(is_a<pseries>(other));
+       const pseries &o = static_cast<const pseries &>(other);
+       
+       // first compare the lengths of the series...
+       if (seq.size()>o.seq.size())
+               return 1;
+       if (seq.size()<o.seq.size())
+               return -1;
+       
+       // ...then the expansion point...
+       int cmpval = var.compare(o.var);
+       if (cmpval)
+               return cmpval;
+       cmpval = point.compare(o.point);
+       if (cmpval)
+               return cmpval;
+       
+       // ...and if that failed the individual elements
+       epvector::const_iterator it = seq.begin(), o_it = o.seq.begin();
+       while (it!=seq.end() && o_it!=o.seq.end()) {
+               cmpval = it->compare(*o_it);
+               if (cmpval)
+                       return cmpval;
+               ++it;
+               ++o_it;
+       }
+
+       // so they are equal.
+       return 0;
+}
+
+/** Return the number of operands including a possible order term. */
+size_t pseries::nops() const
+{
+       return seq.size();
+}
+
+/** Return the ith term in the series when represented as a sum. */
+ex pseries::op(size_t i) const
+{
+       if (i >= seq.size())
+               throw (std::out_of_range("op() out of range"));
+
+       if (is_exactly_a<Order_function>(seq[i].rest))
+               return Order(power(var-point, seq[i].coeff));
+       return seq[i].rest * power(var - point, seq[i].coeff);
+}
+
+/** Return degree of highest power of the series.  This is usually the exponent
+ *  of the Order term.  If s is not the expansion variable of the series, the
+ *  series is examined termwise. */
+int pseries::degree(const ex &s) const
+{
+       if (var.is_equal(s)) {
+               // Return last exponent
+               if (seq.size())
+                       return ex_to<numeric>((seq.end()-1)->coeff).to_int();
+               else
+                       return 0;
+       } else {
+               epvector::const_iterator it = seq.begin(), itend = seq.end();
+               if (it == itend)
+                       return 0;
+               int max_pow = INT_MIN;
+               while (it != itend) {
+                       int pow = it->rest.degree(s);
+                       if (pow > max_pow)
+                               max_pow = pow;
+                       ++it;
+               }
+               return max_pow;
+       }
+}
+
+/** Return degree of lowest power of the series.  This is usually the exponent
+ *  of the leading term.  If s is not the expansion variable of the series, the
+ *  series is examined termwise.  If s is the expansion variable but the
+ *  expansion point is not zero the series is not expanded to find the degree.
+ *  I.e.: (1-x) + (1-x)^2 + Order((1-x)^3) has ldegree(x) 1, not 0. */
+int pseries::ldegree(const ex &s) const
+{
+       if (var.is_equal(s)) {
+               // Return first exponent
+               if (seq.size())
+                       return ex_to<numeric>((seq.begin())->coeff).to_int();
+               else
+                       return 0;
+       } else {
+               epvector::const_iterator it = seq.begin(), itend = seq.end();
+               if (it == itend)
+                       return 0;
+               int min_pow = INT_MAX;
+               while (it != itend) {
+                       int pow = it->rest.ldegree(s);
+                       if (pow < min_pow)
+                               min_pow = pow;
+                       ++it;
+               }
+               return min_pow;
+       }
+}
+
+/** Return coefficient of degree n in power series if s is the expansion
+ *  variable.  If the expansion point is nonzero, by definition the n=1
+ *  coefficient in s of a+b*(s-z)+c*(s-z)^2+Order((s-z)^3) is b (assuming
+ *  the expansion took place in the s in the first place).
+ *  If s is not the expansion variable, an attempt is made to convert the
+ *  series to a polynomial and return the corresponding coefficient from
+ *  there. */
+ex pseries::coeff(const ex &s, int n) const
+{
+       if (var.is_equal(s)) {
+               if (seq.empty())
+                       return _ex0;
+               
+               // Binary search in sequence for given power
+               numeric looking_for = numeric(n);
+               int lo = 0, hi = seq.size() - 1;
+               while (lo <= hi) {
+                       int mid = (lo + hi) / 2;
+                       GINAC_ASSERT(is_exactly_a<numeric>(seq[mid].coeff));
+                       int cmp = ex_to<numeric>(seq[mid].coeff).compare(looking_for);
+                       switch (cmp) {
+                               case -1:
+                                       lo = mid + 1;
+                                       break;
+                               case 0:
+                                       return seq[mid].rest;
+                               case 1:
+                                       hi = mid - 1;
+                                       break;
+                               default:
+                                       throw(std::logic_error("pseries::coeff: compare() didn't return -1, 0 or 1"));
+                       }
+               }
+               return _ex0;
+       } else
+               return convert_to_poly().coeff(s, n);
+}
+
+/** Does nothing. */
+ex pseries::collect(const ex &s, bool distributed) const
+{
+       return *this;
+}
+
+/** Perform coefficient-wise automatic term rewriting rules in this class. */
+ex pseries::eval(int level) const
+{
+       if (level == 1)
+               return this->hold();
+       
+       if (level == -max_recursion_level)
+               throw (std::runtime_error("pseries::eval(): recursion limit exceeded"));
+       
+       // Construct a new series with evaluated coefficients
+       epvector new_seq;
+       new_seq.reserve(seq.size());
+       epvector::const_iterator it = seq.begin(), itend = seq.end();
+       while (it != itend) {
+               new_seq.push_back(expair(it->rest.eval(level-1), it->coeff));
+               ++it;
+       }
+       return (new pseries(relational(var,point), new_seq))->setflag(status_flags::dynallocated | status_flags::evaluated);
+}
+
+/** Evaluate coefficients numerically. */
+ex pseries::evalf(int level) const
+{
+       if (level == 1)
+               return *this;
+       
+       if (level == -max_recursion_level)
+               throw (std::runtime_error("pseries::evalf(): recursion limit exceeded"));
+       
+       // Construct a new series with evaluated coefficients
+       epvector new_seq;
+       new_seq.reserve(seq.size());
+       epvector::const_iterator it = seq.begin(), itend = seq.end();
+       while (it != itend) {
+               new_seq.push_back(expair(it->rest.evalf(level-1), it->coeff));
+               ++it;
+       }
+       return (new pseries(relational(var,point), new_seq))->setflag(status_flags::dynallocated | status_flags::evaluated);
+}
+
+ex pseries::conjugate() const
+{
+       epvector * newseq = conjugateepvector(seq);
+       ex newvar = var.conjugate();
+       ex newpoint = point.conjugate();
+
+       if (!newseq     && are_ex_trivially_equal(newvar, var) && are_ex_trivially_equal(point, newpoint)) {
+               return *this;
+       }
+
+       ex result = (new pseries(newvar==newpoint, newseq ? *newseq : seq))->setflag(status_flags::dynallocated);
+       if (newseq) {
+               delete newseq;
+       }
+       return result;
+}
+
+ex pseries::eval_integ() const
+{
+       epvector *newseq = NULL;
+       for (epvector::const_iterator i=seq.begin(); i!=seq.end(); ++i) {
+               if (newseq) {
+                       newseq->push_back(expair(i->rest.eval_integ(), i->coeff));
+                       continue;
+               }
+               ex newterm = i->rest.eval_integ();
+               if (!are_ex_trivially_equal(newterm, i->rest)) {
+                       newseq = new epvector;
+                       newseq->reserve(seq.size());
+                       for (epvector::const_iterator j=seq.begin(); j!=i; ++j)
+                               newseq->push_back(*j);
+                       newseq->push_back(expair(newterm, i->coeff));
+               }
+       }
+
+       ex newpoint = point.eval_integ();
+       if (newseq || !are_ex_trivially_equal(newpoint, point))
+               return (new pseries(var==newpoint, *newseq))
+                      ->setflag(status_flags::dynallocated);
+       return *this;
+}
+
+ex pseries::subs(const exmap & m, unsigned options) const
+{
+       // If expansion variable is being substituted, convert the series to a
+       // polynomial and do the substitution there because the result might
+       // no longer be a power series
+       if (m.find(var) != m.end())
+               return convert_to_poly(true).subs(m, options);
+       
+       // Otherwise construct a new series with substituted coefficients and
+       // expansion point
+       epvector newseq;
+       newseq.reserve(seq.size());
+       epvector::const_iterator it = seq.begin(), itend = seq.end();
+       while (it != itend) {
+               newseq.push_back(expair(it->rest.subs(m, options), it->coeff));
+               ++it;
+       }
+       return (new pseries(relational(var,point.subs(m, options)), newseq))->setflag(status_flags::dynallocated);
+}
+
+/** Implementation of ex::expand() for a power series.  It expands all the
+ *  terms individually and returns the resulting series as a new pseries. */
+ex pseries::expand(unsigned options) const
+{
+       epvector newseq;
+       epvector::const_iterator i = seq.begin(), end = seq.end();
+       while (i != end) {
+               ex restexp = i->rest.expand();
+               if (!restexp.is_zero())
+                       newseq.push_back(expair(restexp, i->coeff));
+               ++i;
+       }
+       return (new pseries(relational(var,point), newseq))
+               ->setflag(status_flags::dynallocated | (options == 0 ? status_flags::expanded : 0));
+}
+
+/** Implementation of ex::diff() for a power series.
+ *  @see ex::diff */
+ex pseries::derivative(const symbol & s) const
+{
+       epvector new_seq;
+       epvector::const_iterator it = seq.begin(), itend = seq.end();
+
+       if (s == var) {
+               
+               // FIXME: coeff might depend on var
+               while (it != itend) {
+                       if (is_exactly_a<Order_function>(it->rest)) {
+                               new_seq.push_back(expair(it->rest, it->coeff - 1));
+                       } else {
+                               ex c = it->rest * it->coeff;
+                               if (!c.is_zero())
+                                       new_seq.push_back(expair(c, it->coeff - 1));
+                       }
+                       ++it;
+               }
+
+       } else {
+
+               while (it != itend) {
+                       if (is_exactly_a<Order_function>(it->rest)) {
+                               new_seq.push_back(*it);
+                       } else {
+                               ex c = it->rest.diff(s);
+                               if (!c.is_zero())
+                                       new_seq.push_back(expair(c, it->coeff));
+                       }
+                       ++it;
+               }
+       }
+
+       return pseries(relational(var,point), new_seq);
+}
+
+ex pseries::convert_to_poly(bool no_order) const
+{
+       ex e;
+       epvector::const_iterator it = seq.begin(), itend = seq.end();
+       
+       while (it != itend) {
+               if (is_exactly_a<Order_function>(it->rest)) {
+                       if (!no_order)
+                               e += Order(power(var - point, it->coeff));
+               } else
+                       e += it->rest * power(var - point, it->coeff);
+               ++it;
+       }
+       return e;
+}
+
+bool pseries::is_terminating() const
+{
+       return seq.empty() || !is_exactly_a<Order_function>((seq.end()-1)->rest);
+}
+
+ex pseries::coeffop(size_t i) const
+{
+       if (i >=nops())
+               throw (std::out_of_range("coeffop() out of range"));
+       return seq[i].rest;
+}
+
+ex pseries::exponop(size_t i) const
+{
+       if (i >= nops())
+               throw (std::out_of_range("exponop() out of range"));
+       return seq[i].coeff;
+}
+
+
+/*
+ *  Implementations of series expansion
+ */
+
+/** Default implementation of ex::series(). This performs Taylor expansion.
+ *  @see ex::series */
+ex basic::series(const relational & r, int order, unsigned options) const
+{
+       epvector seq;
+       const symbol &s = ex_to<symbol>(r.lhs());
+
+       // default for order-values that make no sense for Taylor expansion
+       if ((order <= 0) && this->has(s)) {
+               seq.push_back(expair(Order(_ex1), order));
+               return pseries(r, seq);
+       }
+
+       // do Taylor expansion
+       numeric fac = 1;
+       ex deriv = *this;
+       ex coeff = deriv.subs(r, subs_options::no_pattern);
+
+       if (!coeff.is_zero()) {
+               seq.push_back(expair(coeff, _ex0));
+       }
+
+       int n;
+       for (n=1; n<order; ++n) {
+               fac = fac.mul(n);
+               // We need to test for zero in order to see if the series terminates.
+               // The problem is that there is no such thing as a perfect test for
+               // zero.  Expanding the term occasionally helps a little...
+               deriv = deriv.diff(s).expand();
+               if (deriv.is_zero())  // Series terminates
+                       return pseries(r, seq);
+
+               coeff = deriv.subs(r, subs_options::no_pattern);
+               if (!coeff.is_zero())
+                       seq.push_back(expair(fac.inverse() * coeff, n));
+       }
+       
+       // Higher-order terms, if present
+       deriv = deriv.diff(s);
+       if (!deriv.expand().is_zero())
+               seq.push_back(expair(Order(_ex1), n));
+       return pseries(r, seq);
+}
+
+
+/** Implementation of ex::series() for symbols.
+ *  @see ex::series */
+ex symbol::series(const relational & r, int order, unsigned options) const
+{
+       epvector seq;
+       const ex point = r.rhs();
+       GINAC_ASSERT(is_a<symbol>(r.lhs()));
+
+       if (this->is_equal_same_type(ex_to<symbol>(r.lhs()))) {
+               if (order > 0 && !point.is_zero())
+                       seq.push_back(expair(point, _ex0));
+               if (order > 1)
+                       seq.push_back(expair(_ex1, _ex1));
+               else
+                       seq.push_back(expair(Order(_ex1), numeric(order)));
+       } else
+               seq.push_back(expair(*this, _ex0));
+       return pseries(r, seq);
+}
+
+
+/** Add one series object to another, producing a pseries object that
+ *  represents the sum.
+ *
+ *  @param other  pseries object to add with
+ *  @return the sum as a pseries */
+ex pseries::add_series(const pseries &other) const
+{
+       // Adding two series with different variables or expansion points
+       // results in an empty (constant) series 
+       if (!is_compatible_to(other)) {
+               epvector nul;
+               nul.push_back(expair(Order(_ex1), _ex0));
+               return pseries(relational(var,point), nul);
+       }
+       
+       // Series addition
+       epvector new_seq;
+       epvector::const_iterator a = seq.begin();
+       epvector::const_iterator b = other.seq.begin();
+       epvector::const_iterator a_end = seq.end();
+       epvector::const_iterator b_end = other.seq.end();
+       int pow_a = INT_MAX, pow_b = INT_MAX;
+       for (;;) {
+               // If a is empty, fill up with elements from b and stop
+               if (a == a_end) {
+                       while (b != b_end) {
+                               new_seq.push_back(*b);
+                               ++b;
+                       }
+                       break;
+               } else
+                       pow_a = ex_to<numeric>((*a).coeff).to_int();
+               
+               // If b is empty, fill up with elements from a and stop
+               if (b == b_end) {
+                       while (a != a_end) {
+                               new_seq.push_back(*a);
+                               ++a;
+                       }
+                       break;
+               } else
+                       pow_b = ex_to<numeric>((*b).coeff).to_int();
+               
+               // a and b are non-empty, compare powers
+               if (pow_a < pow_b) {
+                       // a has lesser power, get coefficient from a
+                       new_seq.push_back(*a);
+                       if (is_exactly_a<Order_function>((*a).rest))
+                               break;
+                       ++a;
+               } else if (pow_b < pow_a) {
+                       // b has lesser power, get coefficient from b
+                       new_seq.push_back(*b);
+                       if (is_exactly_a<Order_function>((*b).rest))
+                               break;
+                       ++b;
+               } else {
+                       // Add coefficient of a and b
+                       if (is_exactly_a<Order_function>((*a).rest) || is_exactly_a<Order_function>((*b).rest)) {
+                               new_seq.push_back(expair(Order(_ex1), (*a).coeff));
+                               break;  // Order term ends the sequence
+                       } else {
+                               ex sum = (*a).rest + (*b).rest;
+                               if (!(sum.is_zero()))
+                                       new_seq.push_back(expair(sum, numeric(pow_a)));
+                               ++a;
+                               ++b;
+                       }
+               }
+       }
+       return pseries(relational(var,point), new_seq);
+}
+
+
+/** Implementation of ex::series() for sums. This performs series addition when
+ *  adding pseries objects.
+ *  @see ex::series */
+ex add::series(const relational & r, int order, unsigned options) const
+{
+       ex acc; // Series accumulator
+       
+       // Get first term from overall_coeff
+       acc = overall_coeff.series(r, order, options);
+       
+       // Add remaining terms
+       epvector::const_iterator it = seq.begin();
+       epvector::const_iterator itend = seq.end();
+       for (; it!=itend; ++it) {
+               ex op;
+               if (is_exactly_a<pseries>(it->rest))
+                       op = it->rest;
+               else
+                       op = it->rest.series(r, order, options);
+               if (!it->coeff.is_equal(_ex1))
+                       op = ex_to<pseries>(op).mul_const(ex_to<numeric>(it->coeff));
+               
+               // Series addition
+               acc = ex_to<pseries>(acc).add_series(ex_to<pseries>(op));
+       }
+       return acc;
+}
+
+
+/** Multiply a pseries object with a numeric constant, producing a pseries
+ *  object that represents the product.
+ *
+ *  @param other  constant to multiply with
+ *  @return the product as a pseries */
+ex pseries::mul_const(const numeric &other) const
+{
+       epvector new_seq;
+       new_seq.reserve(seq.size());
+       
+       epvector::const_iterator it = seq.begin(), itend = seq.end();
+       while (it != itend) {
+               if (!is_exactly_a<Order_function>(it->rest))
+                       new_seq.push_back(expair(it->rest * other, it->coeff));
+               else
+                       new_seq.push_back(*it);
+               ++it;
+       }
+       return pseries(relational(var,point), new_seq);
+}
+
+
+/** Multiply one pseries object to another, producing a pseries object that
+ *  represents the product.
+ *
+ *  @param other  pseries object to multiply with
+ *  @return the product as a pseries */
+ex pseries::mul_series(const pseries &other) const
+{
+       // Multiplying two series with different variables or expansion points
+       // results in an empty (constant) series 
+       if (!is_compatible_to(other)) {
+               epvector nul;
+               nul.push_back(expair(Order(_ex1), _ex0));
+               return pseries(relational(var,point), nul);
+       }
+
+       if (seq.empty() || other.seq.empty()) {
+               return (new pseries(var==point, epvector()))
+                      ->setflag(status_flags::dynallocated);
+       }
+       
+       // Series multiplication
+       epvector new_seq;
+       int a_max = degree(var);
+       int b_max = other.degree(var);
+       int a_min = ldegree(var);
+       int b_min = other.ldegree(var);
+       int cdeg_min = a_min + b_min;
+       int cdeg_max = a_max + b_max;
+       
+       int higher_order_a = INT_MAX;
+       int higher_order_b = INT_MAX;
+       if (is_exactly_a<Order_function>(coeff(var, a_max)))
+               higher_order_a = a_max + b_min;
+       if (is_exactly_a<Order_function>(other.coeff(var, b_max)))
+               higher_order_b = b_max + a_min;
+       int higher_order_c = std::min(higher_order_a, higher_order_b);
+       if (cdeg_max >= higher_order_c)
+               cdeg_max = higher_order_c - 1;
+       
+       for (int cdeg=cdeg_min; cdeg<=cdeg_max; ++cdeg) {
+               ex co = _ex0;
+               // c(i)=a(0)b(i)+...+a(i)b(0)
+               for (int i=a_min; cdeg-i>=b_min; ++i) {
+                       ex a_coeff = coeff(var, i);
+                       ex b_coeff = other.coeff(var, cdeg-i);
+                       if (!is_exactly_a<Order_function>(a_coeff) && !is_exactly_a<Order_function>(b_coeff))
+                               co += a_coeff * b_coeff;
+               }
+               if (!co.is_zero())
+                       new_seq.push_back(expair(co, numeric(cdeg)));
+       }
+       if (higher_order_c < INT_MAX)
+               new_seq.push_back(expair(Order(_ex1), numeric(higher_order_c)));
+       return pseries(relational(var, point), new_seq);
+}
+
+
+/** Implementation of ex::series() for product. This performs series
+ *  multiplication when multiplying series.
+ *  @see ex::series */
+ex mul::series(const relational & r, int order, unsigned options) const
+{
+       pseries acc; // Series accumulator
+
+       GINAC_ASSERT(is_a<symbol>(r.lhs()));
+       const ex& sym = r.lhs();
+               
+       // holds ldegrees of the series of individual factors
+       std::vector<int> ldegrees;
+
+       // find minimal degrees
+       const epvector::const_iterator itbeg = seq.begin();
+       const epvector::const_iterator itend = seq.end();
+       for (epvector::const_iterator it=itbeg; it!=itend; ++it) {
+
+               ex expon = it->coeff;
+               int factor = 1;
+               ex buf;
+               if (expon.info(info_flags::integer)) {
+                       buf = it->rest;
+                       factor = ex_to<numeric>(expon).to_int();
+               } else {
+                       buf = recombine_pair_to_ex(*it);
+               }
+
+               int real_ldegree = 0;
+               try {
+                       real_ldegree = buf.expand().ldegree(sym-r.rhs());
+               } catch (std::runtime_error) {}
+
+               if (real_ldegree == 0) {
+                       int orderloop = 0;
+                       do {
+                               orderloop++;
+                               real_ldegree = buf.series(r, orderloop, options).ldegree(sym);
+                       } while (real_ldegree == orderloop);
+               }
+
+               ldegrees.push_back(factor * real_ldegree);
+       }
+
+       int degsum = std::accumulate(ldegrees.begin(), ldegrees.end(), 0);
+
+       if (degsum >= order) {
+               epvector epv;
+               epv.push_back(expair(Order(_ex1), order));
+               return (new pseries(r, epv))->setflag(status_flags::dynallocated);
+       }
+
+       // Multiply with remaining terms
+       std::vector<int>::const_iterator itd = ldegrees.begin();
+       for (epvector::const_iterator it=itbeg; it!=itend; ++it, ++itd) {
+
+               // do series expansion with adjusted order
+               ex op = recombine_pair_to_ex(*it).series(r, order-degsum+(*itd), options);
+
+               // Series multiplication
+               if (it == itbeg)
+                       acc = ex_to<pseries>(op);
+               else
+                       acc = ex_to<pseries>(acc.mul_series(ex_to<pseries>(op)));
+       }
+
+       return acc.mul_const(ex_to<numeric>(overall_coeff));
+}
+
+
+/** Compute the p-th power of a series.
+ *
+ *  @param p  power to compute
+ *  @param deg  truncation order of series calculation */
+ex pseries::power_const(const numeric &p, int deg) const
+{
+       // method:
+       // (due to Leonhard Euler)
+       // let A(x) be this series and for the time being let it start with a
+       // constant (later we'll generalize):
+       //     A(x) = a_0 + a_1*x + a_2*x^2 + ...
+       // We want to compute
+       //     C(x) = A(x)^p
+       //     C(x) = c_0 + c_1*x + c_2*x^2 + ...
+       // Taking the derivative on both sides and multiplying with A(x) one
+       // immediately arrives at
+       //     C'(x)*A(x) = p*C(x)*A'(x)
+       // Multiplying this out and comparing coefficients we get the recurrence
+       // formula
+       //     c_i = (i*p*a_i*c_0 + ((i-1)*p-1)*a_{i-1}*c_1 + ...
+       //                    ... + (p-(i-1))*a_1*c_{i-1})/(a_0*i)
+       // which can easily be solved given the starting value c_0 = (a_0)^p.
+       // For the more general case where the leading coefficient of A(x) is not
+       // a constant, just consider A2(x) = A(x)*x^m, with some integer m and
+       // repeat the above derivation.  The leading power of C2(x) = A2(x)^2 is
+       // then of course x^(p*m) but the recurrence formula still holds.
+       
+       if (seq.empty()) {
+               // as a special case, handle the empty (zero) series honoring the
+               // usual power laws such as implemented in power::eval()
+               if (p.real().is_zero())
+                       throw std::domain_error("pseries::power_const(): pow(0,I) is undefined");
+               else if (p.real().is_negative())
+                       throw pole_error("pseries::power_const(): division by zero",1);
+               else
+                       return *this;
+       }
+       
+       const int ldeg = ldegree(var);
+       if (!(p*ldeg).is_integer())
+               throw std::runtime_error("pseries::power_const(): trying to assemble a Puiseux series");
+
+       // adjust number of coefficients
+       int numcoeff = deg - (p*ldeg).to_int();
+       if (numcoeff <= 0) {
+               epvector epv;
+               epv.reserve(1);
+               epv.push_back(expair(Order(_ex1), deg));
+               return (new pseries(relational(var,point), epv))
+                      ->setflag(status_flags::dynallocated);
+       }
+       
+       // O(x^n)^(-m) is undefined
+       if (seq.size() == 1 && is_exactly_a<Order_function>(seq[0].rest) && p.real().is_negative())
+               throw pole_error("pseries::power_const(): division by zero",1);
+       
+       // Compute coefficients of the powered series
+       exvector co;
+       co.reserve(numcoeff);
+       co.push_back(power(coeff(var, ldeg), p));
+       for (int i=1; i<numcoeff; ++i) {
+               ex sum = _ex0;
+               for (int j=1; j<=i; ++j) {
+                       ex c = coeff(var, j + ldeg);
+                       if (is_exactly_a<Order_function>(c)) {
+                               co.push_back(Order(_ex1));
+                               break;
+                       } else
+                               sum += (p * j - (i - j)) * co[i - j] * c;
+               }
+               co.push_back(sum / coeff(var, ldeg) / i);
+       }
+       
+       // Construct new series (of non-zero coefficients)
+       epvector new_seq;
+       bool higher_order = false;
+       for (int i=0; i<numcoeff; ++i) {
+               if (!co[i].is_zero())
+                       new_seq.push_back(expair(co[i], p * ldeg + i));
+               if (is_exactly_a<Order_function>(co[i])) {
+                       higher_order = true;
+                       break;
+               }
+       }
+       if (!higher_order)
+               new_seq.push_back(expair(Order(_ex1), p * ldeg + numcoeff));
+
+       return pseries(relational(var,point), new_seq);
+}
+
+
+/** Return a new pseries object with the powers shifted by deg. */
+pseries pseries::shift_exponents(int deg) const
+{
+       epvector newseq = seq;
+       epvector::iterator i = newseq.begin(), end  = newseq.end();
+       while (i != end) {
+               i->coeff += deg;
+               ++i;
+       }
+       return pseries(relational(var, point), newseq);
+}
+
+
+/** Implementation of ex::series() for powers. This performs Laurent expansion
+ *  of reciprocals of series at singularities.
+ *  @see ex::series */
+ex power::series(const relational & r, int order, unsigned options) const
+{
+       // If basis is already a series, just power it
+       if (is_exactly_a<pseries>(basis))
+               return ex_to<pseries>(basis).power_const(ex_to<numeric>(exponent), order);
+
+       // Basis is not a series, may there be a singularity?
+       bool must_expand_basis = false;
+       try {
+               basis.subs(r, subs_options::no_pattern);
+       } catch (pole_error) {
+               must_expand_basis = true;
+       }
+
+       // Is the expression of type something^(-int)?
+       if (!must_expand_basis && !exponent.info(info_flags::negint)
+        && (!is_a<add>(basis) || !is_a<numeric>(exponent)))
+               return basic::series(r, order, options);
+
+       // Is the expression of type 0^something?
+       if (!must_expand_basis && !basis.subs(r, subs_options::no_pattern).is_zero()
+        && (!is_a<add>(basis) || !is_a<numeric>(exponent)))
+               return basic::series(r, order, options);
+
+       // Singularity encountered, is the basis equal to (var - point)?
+       if (basis.is_equal(r.lhs() - r.rhs())) {
+               epvector new_seq;
+               if (ex_to<numeric>(exponent).to_int() < order)
+                       new_seq.push_back(expair(_ex1, exponent));
+               else
+                       new_seq.push_back(expair(Order(_ex1), exponent));
+               return pseries(r, new_seq);
+       }
+
+       // No, expand basis into series
+
+       numeric numexp;
+       if (is_a<numeric>(exponent)) {
+               numexp = ex_to<numeric>(exponent);
+       } else {
+               numexp = 0;
+       }
+       const ex& sym = r.lhs();
+       // find existing minimal degree
+       int real_ldegree = basis.expand().ldegree(sym-r.rhs());
+       if (real_ldegree == 0) {
+               int orderloop = 0;
+               do {
+                       orderloop++;
+                       real_ldegree = basis.series(r, orderloop, options).ldegree(sym);
+               } while (real_ldegree == orderloop);
+       }
+
+       if (!(real_ldegree*numexp).is_integer())
+               throw std::runtime_error("pseries::power_const(): trying to assemble a Puiseux series");
+       ex e = basis.series(r, (order + real_ldegree*(1-numexp)).to_int(), options);
+       
+       ex result;
+       try {
+               result = ex_to<pseries>(e).power_const(numexp, order);
+       } catch (pole_error) {
+               epvector ser;
+               ser.push_back(expair(Order(_ex1), order));
+               result = pseries(r, ser);
+       }
+
+       return result;
+}
+
+
+/** Re-expansion of a pseries object. */
+ex pseries::series(const relational & r, int order, unsigned options) const
+{
+       const ex p = r.rhs();
+       GINAC_ASSERT(is_a<symbol>(r.lhs()));
+       const symbol &s = ex_to<symbol>(r.lhs());
+       
+       if (var.is_equal(s) && point.is_equal(p)) {
+               if (order > degree(s))
+                       return *this;
+               else {
+                       epvector new_seq;
+                       epvector::const_iterator it = seq.begin(), itend = seq.end();
+                       while (it != itend) {
+                               int o = ex_to<numeric>(it->coeff).to_int();
+                               if (o >= order) {
+                                       new_seq.push_back(expair(Order(_ex1), o));
+                                       break;
+                               }
+                               new_seq.push_back(*it);
+                               ++it;
+                       }
+                       return pseries(r, new_seq);
+               }
+       } else
+               return convert_to_poly().series(r, order, options);
+}
+
+ex integral::series(const relational & r, int order, unsigned options) const
+{
+       if (x.subs(r) != x)
+               throw std::logic_error("Cannot series expand wrt dummy variable");
+       
+       // Expanding integrant with r substituted taken in boundaries.
+       ex fseries = f.series(r, order, options);
+       epvector fexpansion;
+       fexpansion.reserve(fseries.nops());
+       for (size_t i=0; i<fseries.nops(); ++i) {
+               ex currcoeff = ex_to<pseries>(fseries).coeffop(i);
+               currcoeff = (currcoeff == Order(_ex1))
+                       ? currcoeff
+                       : integral(x, a.subs(r), b.subs(r), currcoeff);
+               if (currcoeff != 0)
+                       fexpansion.push_back(
+                               expair(currcoeff, ex_to<pseries>(fseries).exponop(i)));
+       }
+
+       // Expanding lower boundary
+       ex result = (new pseries(r, fexpansion))->setflag(status_flags::dynallocated);
+       ex aseries = (a-a.subs(r)).series(r, order, options);
+       fseries = f.series(x == (a.subs(r)), order, options);
+       for (size_t i=0; i<fseries.nops(); ++i) {
+               ex currcoeff = ex_to<pseries>(fseries).coeffop(i);
+               if (is_exactly_a<Order_function>(currcoeff))
+                       break;
+               ex currexpon = ex_to<pseries>(fseries).exponop(i);
+               int orderforf = order-ex_to<numeric>(currexpon).to_int()-1;
+               currcoeff = currcoeff.series(r, orderforf);
+               ex term = ex_to<pseries>(aseries).power_const(ex_to<numeric>(currexpon+1),order);
+               term = ex_to<pseries>(term).mul_const(ex_to<numeric>(-1/(currexpon+1)));
+               term = ex_to<pseries>(term).mul_series(ex_to<pseries>(currcoeff));
+               result = ex_to<pseries>(result).add_series(ex_to<pseries>(term));
+       }
+
+       // Expanding upper boundary
+       ex bseries = (b-b.subs(r)).series(r, order, options);
+       fseries = f.series(x == (b.subs(r)), order, options);
+       for (size_t i=0; i<fseries.nops(); ++i) {
+               ex currcoeff = ex_to<pseries>(fseries).coeffop(i);
+               if (is_exactly_a<Order_function>(currcoeff))
+                       break;
+               ex currexpon = ex_to<pseries>(fseries).exponop(i);
+               int orderforf = order-ex_to<numeric>(currexpon).to_int()-1;
+               currcoeff = currcoeff.series(r, orderforf);
+               ex term = ex_to<pseries>(bseries).power_const(ex_to<numeric>(currexpon+1),order);
+               term = ex_to<pseries>(term).mul_const(ex_to<numeric>(1/(currexpon+1)));
+               term = ex_to<pseries>(term).mul_series(ex_to<pseries>(currcoeff));
+               result = ex_to<pseries>(result).add_series(ex_to<pseries>(term));
+       }
+
+       return result;
+}
+
+
+/** Compute the truncated series expansion of an expression.
+ *  This function returns an expression containing an object of class pseries 
+ *  to represent the series. If the series does not terminate within the given
+ *  truncation order, the last term of the series will be an order term.
+ *
+ *  @param r  expansion relation, lhs holds variable and rhs holds point
+ *  @param order  truncation order of series calculations
+ *  @param options  of class series_options
+ *  @return an expression holding a pseries object */
+ex ex::series(const ex & r, int order, unsigned options) const
+{
+       ex e;
+       relational rel_;
+       
+       if (is_a<relational>(r))
+               rel_ = ex_to<relational>(r);
+       else if (is_a<symbol>(r))
+               rel_ = relational(r,_ex0);
+       else
+               throw (std::logic_error("ex::series(): expansion point has unknown type"));
+       
+       try {
+               e = bp->series(rel_, order, options);
+       } catch (std::exception &x) {
+               throw (std::logic_error(std::string("unable to compute series (") + x.what() + ")"));
+       }
+       return e;
+}
+
+} // namespace GiNaC
diff --git a/ginac/registrar.cpp b/ginac/registrar.cpp
new file mode 100644 (file)
index 0000000..13e1736
--- /dev/null
@@ -0,0 +1,46 @@
+/** @file registrar.cpp
+ *
+ *  GiNaC's class registrar (for class basic and all classes derived from it). */
+
+/*
+ *  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 <string>
+#include <map>
+#include <stdexcept>
+
+#include "registrar.h"
+
+namespace GiNaC {
+
+tinfo_t find_tinfo_key(const std::string &class_name)
+{
+       return registered_class_info::find(class_name)->options.get_id();
+}
+
+unarch_func find_unarch_func(const std::string &class_name)
+{
+       return registered_class_info::find(class_name)->options.get_unarch_func();
+}
+
+factory_p find_func_factory(const std::string& class_name)
+{
+       return registered_class_info::find(class_name)->options.get_func_factory();
+}
+
+} // namespace GiNaC
diff --git a/ginac/registrar.h b/ginac/registrar.h
new file mode 100644 (file)
index 0000000..bcd918e
--- /dev/null
@@ -0,0 +1,200 @@
+/** @file registrar.h
+ *
+ *  GiNaC's class registrar (for class basic and all classes derived from it). */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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
+ */
+
+#ifndef __GINAC_REGISTRAR_H__
+#define __GINAC_REGISTRAR_H__
+
+#include <string>
+#include <list>
+#include <vector>
+
+#include "class_info.h"
+#include "print.h"
+
+namespace GiNaC {
+
+class ex;
+class archive_node;
+
+template <template <class> class> class container;
+typedef container<std::list> lst;
+
+/** Definitions for the tinfo mechanism. */
+typedef const void * tinfo_t;
+struct tinfo_static_t {};
+
+/** Unarchiving function (static member function of every GiNaC class). */
+typedef ex (*unarch_func)(const archive_node &n, lst &sym_lst);
+
+/** Definitions for the function registration mechanism. */
+typedef ex (*factory_p)(const std::vector<ex>& v);
+
+/** This class stores information about a registered GiNaC class. */
+class registered_class_options {
+public:
+       registered_class_options(const char *n, const char *p, tinfo_t ti, unarch_func f)
+        : name(n), parent_name(p), tinfo_key(ti), unarchive(f) {}
+
+       const char *get_name() const { return name; }
+       const char *get_parent_name() const { return parent_name; }
+       tinfo_t get_id() const { return tinfo_key; }
+       unarch_func get_unarch_func() const { return unarchive; }
+       factory_p get_func_factory() const { return function_factory_pointer; }
+       const std::vector<print_functor> &get_print_dispatch_table() const { return print_dispatch_table; }
+
+       template <class Ctx, class T, class C>
+       registered_class_options & print_func(void f(const T &, const C & c, unsigned))
+       {
+               set_print_func(Ctx::get_class_info_static().options.get_id(), f);
+               return *this;
+       }
+
+       template <class Ctx, class T, class C>
+       registered_class_options & print_func(void (T::*f)(const C &, unsigned))
+       {
+               set_print_func(Ctx::get_class_info_static().options.get_id(), f);
+               return *this;
+       }
+
+       template <class Ctx>
+       registered_class_options & print_func(const print_functor & f)
+       {
+               set_print_func(Ctx::get_class_info_static().options.get_id(), f);
+               return *this;
+       }
+
+       void set_print_func(unsigned id, const print_functor & f)
+       {
+               if (id >= print_dispatch_table.size())
+                       print_dispatch_table.resize(id + 1);
+               print_dispatch_table[id] = f;
+       }
+
+       registered_class_options & func_factory(factory_p p)
+       {
+               function_factory_pointer = p;
+               return *this;
+       }
+
+private:
+       const char *name;         /**< Class name. */
+       const char *parent_name;  /**< Name of superclass. */
+       tinfo_t tinfo_key;        /**< Type information key. */
+       unarch_func unarchive;    /**< Pointer to unarchiving function. */
+       std::vector<print_functor> print_dispatch_table; /**< Method table for print() dispatch */
+       factory_p function_factory_pointer; /**< Pointer to function factory. */
+};
+
+typedef class_info<registered_class_options> registered_class_info;
+
+
+/** Primary macro for inclusion in the declaration of each registered class. */
+#define GINAC_DECLARE_REGISTERED_CLASS_NO_CTORS(classname, supername) \
+public: \
+       typedef supername inherited; \
+    static const tinfo_static_t tinfo_static; \
+private: \
+       static GiNaC::registered_class_info reg_info; \
+public: \
+       static GiNaC::registered_class_info &get_class_info_static() { return reg_info; } \
+       virtual const GiNaC::registered_class_info &get_class_info() const { return classname::get_class_info_static(); } \
+       virtual GiNaC::registered_class_info &get_class_info() { return classname::get_class_info_static(); } \
+       virtual const char *class_name() const { return classname::get_class_info_static().options.get_name(); } \
+       \
+       classname(const GiNaC::archive_node &n, GiNaC::lst &sym_lst); \
+       virtual void archive(GiNaC::archive_node &n) const; \
+       static GiNaC::ex unarchive(const GiNaC::archive_node &n, GiNaC::lst &sym_lst); \
+       \
+       class visitor { \
+       public: \
+               virtual void visit(const classname &) = 0; \
+               virtual ~visitor() {}; \
+       };
+
+/** Macro for inclusion in the declaration of each registered class.
+ *  It declares some functions that are common to all classes derived
+ *  from 'basic' as well as all required stuff for the GiNaC class
+ *  registry (mainly needed for archiving). */
+#define GINAC_DECLARE_REGISTERED_CLASS(classname, supername) \
+       GINAC_DECLARE_REGISTERED_CLASS_NO_CTORS(classname, supername) \
+public: \
+       classname(); \
+       virtual classname * duplicate() const { return new classname(*this); } \
+       \
+       virtual void accept(GiNaC::visitor & v) const \
+       { \
+               if (visitor *p = dynamic_cast<visitor *>(&v)) \
+                       p->visit(*this); \
+               else \
+                       inherited::accept(v); \
+       } \
+protected: \
+       virtual int compare_same_type(const GiNaC::basic & other) const; \
+private:
+
+
+/** Macro for inclusion in the implementation of each registered class. */
+#define GINAC_IMPLEMENT_REGISTERED_CLASS(classname, supername) \
+       GiNaC::registered_class_info classname::reg_info = GiNaC::registered_class_info(GiNaC::registered_class_options(#classname, #supername, &classname::tinfo_static, &classname::unarchive)); \
+       const tinfo_static_t classname::tinfo_static = {};
+
+/** Macro for inclusion in the implementation of each registered class.
+ *  Additional options can be specified. */
+#define GINAC_IMPLEMENT_REGISTERED_CLASS_OPT(classname, supername, options) \
+       GiNaC::registered_class_info classname::reg_info = GiNaC::registered_class_info(GiNaC::registered_class_options(#classname, #supername, &classname::tinfo_static, &classname::unarchive).options); \
+       const tinfo_static_t classname::tinfo_static = {};
+
+/** Macro for inclusion in the implementation of each registered class.
+ *  Additional options can be specified. */
+#define GINAC_IMPLEMENT_REGISTERED_CLASS_OPT_T(classname, supername, options) \
+       GiNaC::registered_class_info classname::reg_info = GiNaC::registered_class_info(GiNaC::registered_class_options(#classname, #supername, &classname::tinfo_static, &classname::unarchive).options); \
+       template<> const tinfo_static_t classname::tinfo_static = {};
+
+
+/** Find type information key by class name. */
+extern tinfo_t find_tinfo_key(const std::string &class_name);
+
+/** Find unarchiving function by class name. */
+extern unarch_func find_unarch_func(const std::string &class_name);
+
+/** Find function factory by class name. */
+extern factory_p find_func_factory(const std::string& class_name);
+
+
+/** Add or replace a print method. */
+template <class Alg, class Ctx, class T, class C>
+extern void set_print_func(void f(const T &, const C & c, unsigned))
+{
+       Alg::get_class_info_static().options.set_print_func(Ctx::get_class_info_static().options.get_id(), f);
+}
+
+/** Add or replace a print method. */
+template <class Alg, class Ctx, class T, class C>
+extern void set_print_func(void (T::*f)(const C &, unsigned))
+{
+       Alg::get_class_info_static().options.set_print_func(Ctx::get_class_info_static().options.get_id(), f);
+}
+
+
+} // namespace GiNaC
+
+#endif // ndef __GINAC_REGISTRAR_H__
index f1dc18dffc7ad7a3a8413a0d925d9160a1147ca8..5e39ea591d45d2e2b3fcdbf52ff6c4ebd9e84e39 100644 (file)
@@ -3,7 +3,7 @@
  *  Implementation of GiNaC's symbolic objects. */
 
 /*
- *  GiNaC Copyright (C) 1999 Johannes Gutenberg University Mainz, Germany
+ *  GiNaC Copyright (C) 1999-2006 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
@@ -17,7 +17,7 @@
  *
  *  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  */
 
 #include <string>
 
 #include "symbol.h"
 #include "lst.h"
+#include "archive.h"
+#include "tostring.h"
 #include "utils.h"
-#include "idx.h"
-#include "debugmsg.h"
+#include "inifcns.h"
 
 namespace GiNaC {
 
+GINAC_IMPLEMENT_REGISTERED_CLASS_OPT(symbol, basic,
+  print_func<print_context>(&symbol::do_print).
+  print_func<print_latex>(&symbol::do_print_latex).
+  print_func<print_tree>(&symbol::do_print_tree).
+  print_func<print_python_repr>(&symbol::do_print_python_repr))
+
 //////////
-// default constructor, destructor, copy constructor assignment operator and helpers
+// default constructor
 //////////
 
-symbol::symbol() : basic(TINFO_symbol)
+// symbol
+
+symbol::symbol()
+ : inherited(&symbol::tinfo_static), asexinfop(new assigned_ex_info), serial(next_serial++), name(autoname_prefix() + ToString(serial)), TeX_name(name), ret_type(return_types::commutative), ret_type_tinfo(&symbol::tinfo_static), domain(domain::complex)
+{
+       setflag(status_flags::evaluated | status_flags::expanded);
+}
+
+// realsymbol
+
+realsymbol::realsymbol()
 {
-    debugmsg("symbol default constructor",LOGLEVEL_CONSTRUCT);
-    serial=next_serial++;
-    name=autoname_prefix()+ToString(serial);
-    asexinfop=new assigned_ex_info;
-    setflag(status_flags::evaluated);
+       domain = domain::real;
 }
 
-symbol::~symbol()
+//////////
+// other constructors
+//////////
+
+// public
+
+// symbol
+
+symbol::symbol(const std::string & initname, unsigned domain)
+ : inherited(&symbol::tinfo_static), asexinfop(new assigned_ex_info), serial(next_serial++), name(initname), TeX_name(default_TeX_name()), ret_type(return_types::commutative), ret_type_tinfo(&symbol::tinfo_static), domain(domain)
 {
-    debugmsg("symbol destructor",LOGLEVEL_DESTRUCT);
-    destroy(0);
+       setflag(status_flags::evaluated | status_flags::expanded);
 }
 
-symbol::symbol(symbol const & other)
+symbol::symbol(const std::string & initname, unsigned rt, tinfo_t rtt, unsigned domain)
+ : inherited(&symbol::tinfo_static), asexinfop(new assigned_ex_info), serial(next_serial++), name(initname), TeX_name(default_TeX_name()), ret_type(rt), ret_type_tinfo(rtt), domain(domain)
 {
-    debugmsg("symbol copy constructor",LOGLEVEL_CONSTRUCT);
-    copy(other);
+       setflag(status_flags::evaluated | status_flags::expanded);
 }
 
-void symbol::copy(symbol const & other)
+symbol::symbol(const std::string & initname, const std::string & texname, unsigned domain)
+ : inherited(&symbol::tinfo_static), asexinfop(new assigned_ex_info), serial(next_serial++), name(initname), TeX_name(texname), ret_type(return_types::commutative), ret_type_tinfo(&symbol::tinfo_static), domain(domain)
 {
-    basic::copy(other);
-    name=other.name;
-    serial=other.serial;
-    asexinfop=other.asexinfop;
-    ++asexinfop->refcount;
+       setflag(status_flags::evaluated | status_flags::expanded);
 }
 
-void symbol::destroy(bool call_parent)
+symbol::symbol(const std::string & initname, const std::string & texname, unsigned rt, tinfo_t rtt, unsigned domain)
+ : inherited(&symbol::tinfo_static), asexinfop(new assigned_ex_info), serial(next_serial++), name(initname), TeX_name(texname), ret_type(rt), ret_type_tinfo(rtt), domain(domain)
 {
-    if (--asexinfop->refcount == 0) {
-        delete asexinfop;
-    }
-    if (call_parent) {
-        basic::destroy(call_parent);
-    }
+       setflag(status_flags::evaluated | status_flags::expanded);
 }
 
-// how should the following be interpreted?
-// symbol x;
-// symbol y;
-// x=y;
-// probably as: x=ex(y);
+// realsymbol
+       
+realsymbol::realsymbol(const std::string & initname, unsigned domain)
+ : symbol(initname, domain) { }
+
+realsymbol::realsymbol(const std::string & initname, const std::string & texname, unsigned domain)
+ : symbol(initname, texname, domain) { }
+
+realsymbol::realsymbol(const std::string & initname, unsigned rt, tinfo_t rtt, unsigned domain)
+ : symbol(initname, rt, rtt, domain) { }
+
+realsymbol::realsymbol(const std::string & initname, const std::string & texname, unsigned rt, tinfo_t rtt, unsigned domain)
+ : symbol(initname, texname, rt, rtt, domain) { }
 
 //////////
-// other constructors
+// archiving
 //////////
 
-// public
+/** Construct object from archive_node. */
+symbol::symbol(const archive_node &n, lst &sym_lst)
+ : inherited(n, sym_lst), asexinfop(new assigned_ex_info), serial(next_serial++)
+{
+       if (!n.find_string("name", name))
+               name = autoname_prefix() + ToString(serial);
+       if (!n.find_string("TeXname", TeX_name))
+               TeX_name = default_TeX_name();
+       if (!n.find_unsigned("domain", domain))
+               domain = domain::complex;
+       if (!n.find_unsigned("return_type", ret_type))
+               ret_type = return_types::commutative;
+       setflag(status_flags::evaluated | status_flags::expanded);
+}
 
-symbol::symbol(string const & initname) : basic(TINFO_symbol)
+/** Unarchive the object. */
+ex symbol::unarchive(const archive_node &n, lst &sym_lst)
 {
-    debugmsg("symbol constructor from string",LOGLEVEL_CONSTRUCT);
-    name=initname;
-    serial=next_serial++;
-    asexinfop=new assigned_ex_info;
-    setflag(status_flags::evaluated);
+       ex s = (new symbol(n, sym_lst))->setflag(status_flags::dynallocated);
+
+       // If symbol is in sym_lst, return the existing symbol
+       for (lst::const_iterator it = sym_lst.begin(); it != sym_lst.end(); ++it) {
+               if (is_a<symbol>(*it) && (ex_to<symbol>(*it).name == ex_to<symbol>(s).name))
+                       return *it;
+       }
+
+       // Otherwise add new symbol to list and return it
+       sym_lst.append(s);
+       return s;
+}
+
+/** Archive the object. */
+void symbol::archive(archive_node &n) const
+{
+       inherited::archive(n);
+       n.add_string("name", name);
+       if (TeX_name != default_TeX_name())
+               n.add_string("TeX_name", TeX_name);
+       if (domain != domain::complex)
+               n.add_unsigned("domain", domain);
+       if (ret_type != return_types::commutative)
+               n.add_unsigned("return_type", ret_type);
 }
 
 //////////
-// functions overriding virtual functions from bases classes
+// functions overriding virtual functions from base classes
 //////////
 
 // public
 
-basic * symbol::duplicate() const
+void symbol::do_print(const print_context & c, unsigned level) const
 {
-    debugmsg("symbol duplicate",LOGLEVEL_DUPLICATE);
-    return new symbol(*this);
+       c.s << name;
 }
 
-bool symbol::info(unsigned inf) const
+void symbol::do_print_latex(const print_latex & c, unsigned level) const
 {
-    if (inf==info_flags::symbol) return true;
-    if (inf==info_flags::polynomial || inf==info_flags::integer_polynomial || inf==info_flags::rational_polynomial || inf==info_flags::rational_function) {
-        return true;
-    } else {
-        return basic::info(inf);
-    }
+       c.s << TeX_name;
 }
 
-ex symbol::expand(unsigned options) const
+void symbol::do_print_tree(const print_tree & c, unsigned level) const
 {
-    return this->hold();
+       c.s << std::string(level, ' ') << name << " (" << class_name() << ")" << " @" << this
+           << ", serial=" << serial
+           << std::hex << ", hash=0x" << hashvalue << ", flags=0x" << flags << std::dec
+           << ", domain=" << domain
+           << std::endl;
 }
 
-bool symbol::has(ex const & other) const
+void symbol::do_print_python_repr(const print_python_repr & c, unsigned level) const
 {
-    if (is_equal(*other.bp)) return true;
-    return false;
+       c.s << class_name() << "('" << name;
+       if (TeX_name != default_TeX_name())
+               c.s << "','" << TeX_name;
+       c.s << "')";
 }
 
-int symbol::degree(symbol const & s) const
-{
-    return compare_same_type(s)==0 ? 1 : 0;
-}
-
-int symbol::ldegree(symbol const & s) const
+bool symbol::info(unsigned inf) const
 {
-    return compare_same_type(s)==0 ? 1 : 0;
+       if (inf == info_flags::symbol)
+               return true;
+       if (inf == info_flags::polynomial ||
+           inf == info_flags::integer_polynomial ||
+           inf == info_flags::cinteger_polynomial ||
+           inf == info_flags::rational_polynomial ||
+           inf == info_flags::crational_polynomial ||
+           inf == info_flags::rational_function)
+               return true;
+       if (inf == info_flags::real)
+               return domain == domain::real;
+       else
+               return inherited::info(inf);
 }
 
-ex symbol::coeff(symbol const & s, int const n) const
+ex symbol::eval(int level) const
 {
-    if (compare_same_type(s)==0) {
-        return n==1 ? exONE() : exZERO();
-    } else {
-        return n==0 ? *this : exZERO();
-    }
+       if (level == -max_recursion_level)
+               throw(std::runtime_error("max recursion level reached"));
+       
+       if (asexinfop->is_assigned) {
+               setflag(status_flags::evaluated);
+               if (level==1)
+                       return (asexinfop->assigned_expression);
+               else
+                       return (asexinfop->assigned_expression).eval(level);
+       } else {
+               return this->hold();
+       }
 }
 
-ex symbol::eval(int level) const
+ex symbol::conjugate() const
 {
-    if (level == -max_recursion_level) {
-        throw(std::runtime_error("max recursion level reached"));
-    }
-    
-    if (asexinfop->is_assigned) {
-        setflag(status_flags::evaluated);
-        if (level==1) {
-            return (asexinfop->assigned_expression);
-        } else {
-            return (asexinfop->assigned_expression).eval(level);
-        }
-    } else {
-        return this->hold();
-    }
+       if (this->domain == domain::complex) {
+               return GiNaC::conjugate(*this);
+       } else {
+               return *this;
+       }
 }
 
-ex symbol::subs(lst const & ls, lst const & lr) const
+bool symbol::is_polynomial(const ex & var) const
 {
-    GINAC_ASSERT(ls.nops()==lr.nops());
-#ifdef DO_GINAC_ASSERT
-    for (int i=0; i<ls.nops(); i++) {
-        GINAC_ASSERT(is_ex_exactly_of_type(ls.op(i),symbol)||
-               is_ex_of_type(ls.op(i),idx));
-    }
-#endif // def DO_GINAC_ASSERT
-
-    for (int i=0; i<ls.nops(); i++) {
-        if (is_ex_exactly_of_type(ls.op(i),symbol)) {
-            if (compare_same_type(ex_to_symbol(ls.op(i)))==0) return lr.op(i);
-        }
-    }
-    return *this;
+       return true;
 }
 
 // protected
 
-int symbol::compare_same_type(basic const & other) const
+/** Implementation of ex::diff() for single differentiation of a symbol.
+ *  It returns 1 or 0.
+ *
+ *  @see ex::diff */
+ex symbol::derivative(const symbol & s) const
 {
-    GINAC_ASSERT(is_of_type(other,symbol));
-    const symbol *o = static_cast<const symbol *>(&other);
-    if (serial==o->serial) return 0;
-    return serial < o->serial ? -1 : 1;
+       if (compare_same_type(s))
+               return _ex0;
+       else
+               return _ex1;
 }
 
-bool symbol::is_equal_same_type(basic const & other) const
+int symbol::compare_same_type(const basic & other) const
 {
-    GINAC_ASSERT(is_of_type(other,symbol));
-    const symbol *o = static_cast<const symbol *>(&other);
-    return serial==o->serial;
+       GINAC_ASSERT(is_a<symbol>(other));
+       const symbol *o = static_cast<const symbol *>(&other);
+       if (serial==o->serial) return 0;
+       return serial < o->serial ? -1 : 1;
 }
 
-unsigned symbol::return_type(void) const
+bool symbol::is_equal_same_type(const basic & other) const
 {
-    return return_types::commutative;
-}
-   
-unsigned symbol::return_type_tinfo(void) const
-{
-    return tinfo_key;
+       GINAC_ASSERT(is_a<symbol>(other));
+       const symbol *o = static_cast<const symbol *>(&other);
+       return serial==o->serial;
 }
 
-unsigned symbol::calchash(void) const
+unsigned symbol::calchash() const
 {
-    // return golden_ratio_hash(tinfo()) ^ serial;
-    hashvalue=golden_ratio_hash(golden_ratio_hash(0x55555555U ^ serial));
-    setflag(status_flags::hash_calculated);
-    return hashvalue;
+       hashvalue = golden_ratio_hash((p_int)tinfo() ^ serial);
+       setflag(status_flags::hash_calculated);
+       return hashvalue;
 }
 
 //////////
@@ -231,28 +279,52 @@ unsigned symbol::calchash(void) const
 
 // public
 
-void symbol::assign(ex const & value)
+void symbol::assign(const ex & value)
 {
-    asexinfop->is_assigned=1;
-    asexinfop->assigned_expression=value;
-    clearflag(status_flags::evaluated);
+       asexinfop->is_assigned = true;
+       asexinfop->assigned_expression = value;
+       clearflag(status_flags::evaluated | status_flags::expanded);
 }
 
-void symbol::unassign(void)
+void symbol::unassign()
 {
-    if (asexinfop->is_assigned) {
-        asexinfop->is_assigned=0;
-        asexinfop->assigned_expression=exZERO();
-    }
-    setflag(status_flags::evaluated);
+       if (asexinfop->is_assigned) {
+               asexinfop->is_assigned = false;
+               asexinfop->assigned_expression = _ex0;
+       }
+       setflag(status_flags::evaluated | status_flags::expanded);
 }
 
 // private
 
-string & symbol::autoname_prefix(void)
+/** Symbols not constructed with a string get one assigned using this
+ *  prefix and a number. */
+std::string & symbol::autoname_prefix()
+{
+       static std::string *s = new std::string("symbol");
+       return *s;
+}
+
+/** Return default TeX name for symbol. This recognizes some greek letters. */
+std::string symbol::default_TeX_name() const
 {
-    static string * s=new string("symbol");
-    return *s;
+       if (name=="alpha"        || name=="beta"         || name=="gamma"
+        || name=="delta"        || name=="epsilon"      || name=="varepsilon"
+        || name=="zeta"         || name=="eta"          || name=="theta"
+        || name=="vartheta"     || name=="iota"         || name=="kappa"
+        || name=="lambda"       || name=="mu"           || name=="nu"
+        || name=="xi"           || name=="omicron"      || name=="pi"
+        || name=="varpi"        || name=="rho"          || name=="varrho"
+        || name=="sigma"        || name=="varsigma"     || name=="tau"
+        || name=="upsilon"      || name=="phi"          || name=="varphi"
+        || name=="chi"          || name=="psi"          || name=="omega"
+        || name=="Gamma"        || name=="Delta"        || name=="Theta"
+        || name=="Lambda"       || name=="Xi"           || name=="Pi"
+        || name=="Sigma"        || name=="Upsilon"      || name=="Phi"
+        || name=="Psi"          || name=="Omega")
+               return "\\" + name;
+       else
+               return name;
 }
 
 //////////
@@ -261,23 +333,14 @@ string & symbol::autoname_prefix(void)
 
 // private
 
-unsigned symbol::next_serial=0;
-
-// string const symbol::autoname_prefix="symbol";
-
-//////////
-// global constants
-//////////
-
-const symbol some_symbol;
-type_info const & typeid_symbol=typeid(some_symbol);
+unsigned symbol::next_serial = 0;
 
 //////////
 // subclass assigned_ex_info
 //////////
 
 /** Default ctor.  Defaults to unassigned. */
-symbol::assigned_ex_info::assigned_ex_info(void) : is_assigned(0), refcount(1)
+symbol::assigned_ex_info::assigned_ex_info() throw() : is_assigned(false)
 {
 }
 
diff --git a/ginac/symmetry.cpp b/ginac/symmetry.cpp
new file mode 100644 (file)
index 0000000..10157e0
--- /dev/null
@@ -0,0 +1,498 @@
+/** @file symmetry.cpp
+ *
+ *  Implementation of GiNaC's symmetry definitions. */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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 <iostream>
+#include <stdexcept>
+#include <functional>
+
+#include "symmetry.h"
+#include "lst.h"
+#include "inifcns.h" // for factorial()
+#include "operators.h"
+#include "archive.h"
+#include "utils.h"
+
+namespace GiNaC {
+
+GINAC_IMPLEMENT_REGISTERED_CLASS_OPT(symmetry, basic,
+  print_func<print_context>(&symmetry::do_print).
+  print_func<print_tree>(&symmetry::do_print_tree))
+
+/*
+   Some notes about the structure of a symmetry tree:
+    - The leaf nodes of the tree are of type "none", have one index, and no
+      children (of course). They are constructed by the symmetry(unsigned)
+      constructor.
+    - Leaf nodes are the only nodes that only have one index.
+    - Container nodes contain two or more children. The "indices" set member
+      is the set union of the index sets of all children, and the "children"
+      vector stores the children themselves.
+    - The index set of each child of a "symm", "anti" or "cycl" node must
+      have the same size. It follows that the children of such a node are
+      either all leaf nodes, or all container nodes with two or more indices.
+*/
+
+//////////
+// default constructor
+//////////
+
+symmetry::symmetry() : inherited(&symmetry::tinfo_static), type(none)
+{
+       setflag(status_flags::evaluated | status_flags::expanded);
+}
+
+//////////
+// other constructors
+//////////
+
+symmetry::symmetry(unsigned i) : inherited(&symmetry::tinfo_static), type(none)
+{
+       indices.insert(i);
+       setflag(status_flags::evaluated | status_flags::expanded);
+}
+
+symmetry::symmetry(symmetry_type t, const symmetry &c1, const symmetry &c2) : inherited(&symmetry::tinfo_static), type(t)
+{
+       add(c1); add(c2);
+       setflag(status_flags::evaluated | status_flags::expanded);
+}
+
+//////////
+// archiving
+//////////
+
+/** Construct object from archive_node. */
+symmetry::symmetry(const archive_node &n, lst &sym_lst) : inherited(n, sym_lst)
+{
+       unsigned t;
+       if (!(n.find_unsigned("type", t)))
+               throw (std::runtime_error("unknown symmetry type in archive"));
+       type = (symmetry_type)t;
+
+       unsigned i = 0;
+       while (true) {
+               ex e;
+               if (n.find_ex("child", e, sym_lst, i))
+                       add(ex_to<symmetry>(e));
+               else
+                       break;
+               i++;
+       }
+
+       if (i == 0) {
+               while (true) {
+                       unsigned u;
+                       if (n.find_unsigned("index", u, i))
+                               indices.insert(u);
+                       else
+                               break;
+                       i++;
+               }
+       }
+}
+
+/** Archive the object. */
+void symmetry::archive(archive_node &n) const
+{
+       inherited::archive(n);
+
+       n.add_unsigned("type", type);
+
+       if (children.empty()) {
+               std::set<unsigned>::const_iterator i = indices.begin(), iend = indices.end();
+               while (i != iend) {
+                       n.add_unsigned("index", *i);
+                       i++;
+               }
+       } else {
+               exvector::const_iterator i = children.begin(), iend = children.end();
+               while (i != iend) {
+                       n.add_ex("child", *i);
+                       i++;
+               }
+       }
+}
+
+DEFAULT_UNARCHIVE(symmetry)
+
+//////////
+// functions overriding virtual functions from base classes
+//////////
+
+int symmetry::compare_same_type(const basic & other) const
+{
+       GINAC_ASSERT(is_a<symmetry>(other));
+
+       // All symmetry trees are equal. They are not supposed to appear in
+       // ordinary expressions anyway...
+       return 0;
+}
+
+void symmetry::do_print(const print_context & c, unsigned level) const
+{
+       if (children.empty()) {
+               if (indices.size() > 0)
+                       c.s << *(indices.begin());
+               else
+                       c.s << "none";
+       } else {
+               switch (type) {
+                       case none: c.s << '!'; break;
+                       case symmetric: c.s << '+'; break;
+                       case antisymmetric: c.s << '-'; break;
+                       case cyclic: c.s << '@'; break;
+                       default: c.s << '?'; break;
+               }
+               c.s << '(';
+               size_t num = children.size();
+               for (size_t i=0; i<num; i++) {
+                       children[i].print(c);
+                       if (i != num - 1)
+                               c.s << ",";
+               }
+               c.s << ')';
+       }
+}
+
+void symmetry::do_print_tree(const print_tree & c, unsigned level) const
+{
+       c.s << std::string(level, ' ') << class_name() << " @" << this
+           << std::hex << ", hash=0x" << hashvalue << ", flags=0x" << flags << std::dec
+           << ", type=";
+
+       switch (type) {
+               case none: c.s << "none"; break;
+               case symmetric: c.s << "symm"; break;
+               case antisymmetric: c.s << "anti"; break;
+               case cyclic: c.s << "cycl"; break;
+               default: c.s << "<unknown>"; break;
+       }
+
+       c.s << ", indices=(";
+       if (!indices.empty()) {
+               std::set<unsigned>::const_iterator i = indices.begin(), end = indices.end();
+               --end;
+               while (i != end)
+                       c.s << *i++ << ",";
+               c.s << *i;
+       }
+       c.s << ")\n";
+
+       exvector::const_iterator i = children.begin(), end = children.end();
+       while (i != end) {
+               i->print(c, level + c.delta_indent);
+               ++i;
+       }
+}
+
+//////////
+// non-virtual functions in this class
+//////////
+
+symmetry &symmetry::add(const symmetry &c)
+{
+       // All children must have the same number of indices
+       if (type != none && !children.empty()) {
+               GINAC_ASSERT(is_exactly_a<symmetry>(children[0]));
+               if (ex_to<symmetry>(children[0]).indices.size() != c.indices.size())
+                       throw (std::logic_error("symmetry:add(): children must have same number of indices"));
+       }
+
+       // Compute union of indices and check whether the two sets are disjoint
+       std::set<unsigned> un;
+       set_union(indices.begin(), indices.end(), c.indices.begin(), c.indices.end(), inserter(un, un.begin()));
+       if (un.size() != indices.size() + c.indices.size())
+               throw (std::logic_error("symmetry::add(): the same index appears in more than one child"));
+
+       // Set new index set
+       indices.swap(un);
+
+       // Add child node
+       children.push_back(c);
+       return *this;
+}
+
+void symmetry::validate(unsigned n)
+{
+       if (indices.upper_bound(n - 1) != indices.end())
+               throw (std::range_error("symmetry::verify(): index values are out of range"));
+       if (type != none && indices.empty()) {
+               for (unsigned i=0; i<n; i++)
+                       add(i);
+       }
+}
+
+//////////
+// global functions
+//////////
+
+static const symmetry & index0()
+{
+       static ex s = (new symmetry(0))->setflag(status_flags::dynallocated);
+       return ex_to<symmetry>(s);
+}
+
+static const symmetry & index1()
+{
+       static ex s = (new symmetry(1))->setflag(status_flags::dynallocated);
+       return ex_to<symmetry>(s);
+}
+
+static const symmetry & index2()
+{
+       static ex s = (new symmetry(2))->setflag(status_flags::dynallocated);
+       return ex_to<symmetry>(s);
+}
+
+static const symmetry & index3()
+{
+       static ex s = (new symmetry(3))->setflag(status_flags::dynallocated);
+       return ex_to<symmetry>(s);
+}
+
+const symmetry & not_symmetric()
+{
+       static ex s = (new symmetry)->setflag(status_flags::dynallocated);
+       return ex_to<symmetry>(s);
+}
+
+const symmetry & symmetric2()
+{
+       static ex s = (new symmetry(symmetry::symmetric, index0(), index1()))->setflag(status_flags::dynallocated);
+       return ex_to<symmetry>(s);
+}
+
+const symmetry & symmetric3()
+{
+       static ex s = (new symmetry(symmetry::symmetric, index0(), index1()))->add(index2()).setflag(status_flags::dynallocated);
+       return ex_to<symmetry>(s);
+}
+
+const symmetry & symmetric4()
+{
+       static ex s = (new symmetry(symmetry::symmetric, index0(), index1()))->add(index2()).add(index3()).setflag(status_flags::dynallocated);
+       return ex_to<symmetry>(s);
+}
+
+const symmetry & antisymmetric2()
+{
+       static ex s = (new symmetry(symmetry::antisymmetric, index0(), index1()))->setflag(status_flags::dynallocated);
+       return ex_to<symmetry>(s);
+}
+
+const symmetry & antisymmetric3()
+{
+       static ex s = (new symmetry(symmetry::antisymmetric, index0(), index1()))->add(index2()).setflag(status_flags::dynallocated);
+       return ex_to<symmetry>(s);
+}
+
+const symmetry & antisymmetric4()
+{
+       static ex s = (new symmetry(symmetry::antisymmetric, index0(), index1()))->add(index2()).add(index3()).setflag(status_flags::dynallocated);
+       return ex_to<symmetry>(s);
+}
+
+class sy_is_less : public std::binary_function<ex, ex, bool> {
+       exvector::iterator v;
+
+public:
+       sy_is_less(exvector::iterator v_) : v(v_) {}
+
+       bool operator() (const ex &lh, const ex &rh) const
+       {
+               GINAC_ASSERT(is_exactly_a<symmetry>(lh));
+               GINAC_ASSERT(is_exactly_a<symmetry>(rh));
+               GINAC_ASSERT(ex_to<symmetry>(lh).indices.size() == ex_to<symmetry>(rh).indices.size());
+               std::set<unsigned>::const_iterator ait = ex_to<symmetry>(lh).indices.begin(), aitend = ex_to<symmetry>(lh).indices.end(), bit = ex_to<symmetry>(rh).indices.begin();
+               while (ait != aitend) {
+                       int cmpval = v[*ait].compare(v[*bit]);
+                       if (cmpval < 0)
+                               return true;
+                       else if (cmpval > 0)
+                               return false;
+                       ++ait; ++bit;
+               }
+               return false;
+       }
+};
+
+class sy_swap : public std::binary_function<ex, ex, void> {
+       exvector::iterator v;
+
+public:
+       bool &swapped;
+
+       sy_swap(exvector::iterator v_, bool &s) : v(v_), swapped(s) {}
+
+       void operator() (const ex &lh, const ex &rh)
+       {
+               GINAC_ASSERT(is_exactly_a<symmetry>(lh));
+               GINAC_ASSERT(is_exactly_a<symmetry>(rh));
+               GINAC_ASSERT(ex_to<symmetry>(lh).indices.size() == ex_to<symmetry>(rh).indices.size());
+               std::set<unsigned>::const_iterator ait = ex_to<symmetry>(lh).indices.begin(), aitend = ex_to<symmetry>(lh).indices.end(), bit = ex_to<symmetry>(rh).indices.begin();
+               while (ait != aitend) {
+                       v[*ait].swap(v[*bit]);
+                       ++ait; ++bit;
+               }
+               swapped = true;
+       }
+};
+
+int canonicalize(exvector::iterator v, const symmetry &symm)
+{
+       // Less than two elements? Then do nothing
+       if (symm.indices.size() < 2)
+               return INT_MAX;
+
+       // Canonicalize children first
+       bool something_changed = false;
+       int sign = 1;
+       exvector::const_iterator first = symm.children.begin(), last = symm.children.end();
+       while (first != last) {
+               GINAC_ASSERT(is_exactly_a<symmetry>(*first));
+               int child_sign = canonicalize(v, ex_to<symmetry>(*first));
+               if (child_sign == 0)
+                       return 0;
+               if (child_sign != INT_MAX) {
+                       something_changed = true;
+                       sign *= child_sign;
+               }
+               first++;
+       }
+
+       // Now reorder the children
+       first = symm.children.begin();
+       switch (symm.type) {
+               case symmetry::symmetric:
+                       // Sort the children in ascending order
+                       shaker_sort(first, last, sy_is_less(v), sy_swap(v, something_changed));
+                       break;
+               case symmetry::antisymmetric:
+                       // Sort the children in ascending order, keeping track of the signum
+                       sign *= permutation_sign(first, last, sy_is_less(v), sy_swap(v, something_changed));
+                       if (sign == 0)
+                               return 0;
+                       break;
+               case symmetry::cyclic:
+                       // Permute the smallest child to the front
+                       cyclic_permutation(first, last, min_element(first, last, sy_is_less(v)), sy_swap(v, something_changed));
+                       break;
+               default:
+                       break;
+       }
+       return something_changed ? sign : INT_MAX;
+}
+
+
+// Symmetrize/antisymmetrize over a vector of objects
+static ex symm(const ex & e, exvector::const_iterator first, exvector::const_iterator last, bool asymmetric)
+{
+       // Need at least 2 objects for this operation
+       unsigned num = last - first;
+       if (num < 2)
+               return e;
+
+       // Transform object vector to a lst (for subs())
+       lst orig_lst(first, last);
+
+       // Create index vectors for permutation
+       unsigned *iv = new unsigned[num], *iv2;
+       for (unsigned i=0; i<num; i++)
+               iv[i] = i;
+       iv2 = (asymmetric ? new unsigned[num] : NULL);
+
+       // Loop over all permutations (the first permutation, which is the
+       // identity, is unrolled)
+       ex sum = e;
+       while (std::next_permutation(iv, iv + num)) {
+               lst new_lst;
+               for (unsigned i=0; i<num; i++)
+                       new_lst.append(orig_lst.op(iv[i]));
+               ex term = e.subs(orig_lst, new_lst, subs_options::no_pattern|subs_options::no_index_renaming);
+               if (asymmetric) {
+                       memcpy(iv2, iv, num * sizeof(unsigned));
+                       term *= permutation_sign(iv2, iv2 + num);
+               }
+               sum += term;
+       }
+
+       delete[] iv;
+       delete[] iv2;
+
+       return sum / factorial(numeric(num));
+}
+
+ex symmetrize(const ex & e, exvector::const_iterator first, exvector::const_iterator last)
+{
+       return symm(e, first, last, false);
+}
+
+ex antisymmetrize(const ex & e, exvector::const_iterator first, exvector::const_iterator last)
+{
+       return symm(e, first, last, true);
+}
+
+ex symmetrize_cyclic(const ex & e, exvector::const_iterator first, exvector::const_iterator last)
+{
+       // Need at least 2 objects for this operation
+       unsigned num = last - first;
+       if (num < 2)
+               return e;
+
+       // Transform object vector to a lst (for subs())
+       lst orig_lst(first, last);
+       lst new_lst = orig_lst;
+
+       // Loop over all cyclic permutations (the first permutation, which is
+       // the identity, is unrolled)
+       ex sum = e;
+       for (unsigned i=0; i<num-1; i++) {
+               ex perm = new_lst.op(0);
+               new_lst.remove_first().append(perm);
+               sum += e.subs(orig_lst, new_lst, subs_options::no_pattern|subs_options::no_index_renaming);
+       }
+       return sum / num;
+}
+
+/** Symmetrize expression over a list of objects (symbols, indices). */
+ex ex::symmetrize(const lst & l) const
+{
+       exvector v(l.begin(), l.end());
+       return symm(*this, v.begin(), v.end(), false);
+}
+
+/** Antisymmetrize expression over a list of objects (symbols, indices). */
+ex ex::antisymmetrize(const lst & l) const
+{
+       exvector v(l.begin(), l.end());
+       return symm(*this, v.begin(), v.end(), true);
+}
+
+/** Symmetrize expression by cyclic permutation over a list of objects
+ *  (symbols, indices). */
+ex ex::symmetrize_cyclic(const lst & l) const
+{
+       exvector v(l.begin(), l.end());
+       return GiNaC::symmetrize_cyclic(*this, v.begin(), v.end());
+}
+
+} // namespace GiNaC
index f8702d2aea4b7640eb24c5933353ccc4b8b6bc24..dc1d7a19179bf9cfaadfc98692577ab357df2c17 100644 (file)
@@ -1,9 +1,10 @@
 /** @file ginsh_parser.yy
  *
  *  Input grammar definition for ginsh.
- *  This file must be processed with yacc/bison.
- *
- *  GiNaC Copyright (C) 1999 Johannes Gutenberg University Mainz, Germany
+ *  This file must be processed with yacc/bison. */
+
+/*
+ *  GiNaC Copyright (C) 1999-2006 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
@@ -17,7 +18,7 @@
  *
  *  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  */
 
 
 
 %{
 #include "config.h"
-
+#ifdef HAVE_RUSAGE
 #include <sys/resource.h>
+#else
+#include <ctime>
+#endif
 
 #if HAVE_UNISTD_H
 #include <sys/types.h>
 
 #include "ginsh.h"
 
+#define YYERROR_VERBOSE 1
+
 // Original readline settings
 static int orig_completion_append_character;
+#if (GINAC_RL_VERSION_MAJOR < 4) || (GINAC_RL_VERSION_MAJOR == 4 && GINAC_RL_VERSION_MINOR < 2)
 static char *orig_basic_word_break_characters;
+#else
+static const char *orig_basic_word_break_characters;
+#endif
+
+#if (GINAC_RL_VERSION_MAJOR >= 5)
+#define GINAC_RL_COMPLETER_CAST(a) const_cast<char *>((a))
+#else
+#define GINAC_RL_COMPLETER_CAST(a) (a)
+#endif
 
-// Expression stack for ", "" and """
+// Expression stack for %, %% and %%%
 static void push(const ex &e);
 static ex exstack[3];
 
 // Start and end time for the time() function
+#ifdef HAVE_RUSAGE
 static struct rusage start_time, end_time;
+#define START_TIMER getrusage(RUSAGE_SELF, &start_time);
+#define STOP_TIMER getrusage(RUSAGE_SELF, &end_time);
+#define PRINT_TIME_USED cout << \
+   (end_time.ru_utime.tv_sec - start_time.ru_utime.tv_sec) + \
+       (end_time.ru_stime.tv_sec - start_time.ru_stime.tv_sec) + \
+       double(end_time.ru_utime.tv_usec - start_time.ru_utime.tv_usec) / 1e6 + \
+       double(end_time.ru_stime.tv_usec - start_time.ru_stime.tv_usec) / 1e6 \
+                       << 's' << endl;
+#else
+static std::clock_t start_time, end_time;
+#define START_TIMER start_time = std::clock();
+#define STOP_TIMER end_time = std::clock();
+#define PRINT_TIME_USED \
+  cout << double(end_time - start_time)/CLOCKS_PER_SEC << 's' << endl;
+#endif
 
 // Table of functions (a multimap, because one function may appear with different
 // numbers of parameters)
@@ -56,8 +88,8 @@ typedef ex (*fcnp)(const exprseq &e);
 typedef ex (*fcnp2)(const exprseq &e, int serial);
 
 struct fcn_desc {
-       fcn_desc() : p(NULL), num_params(0) {}
-       fcn_desc(fcnp func, int num) : p(func), num_params(num), is_ginac(false) {}
+       fcn_desc() : p(NULL), num_params(0), is_ginac(false), serial(0) {}
+       fcn_desc(fcnp func, int num) : p(func), num_params(num), is_ginac(false), serial(0) {}
        fcn_desc(fcnp2 func, int num, int ser) : p((fcnp)func), num_params(num), is_ginac(true), serial(ser) {}
 
        fcnp p;         // Pointer to function
@@ -75,25 +107,25 @@ static fcn_tab::const_iterator find_function(const ex &sym, int req_params);
 typedef multimap<string, string> help_tab;
 static help_tab help;
 
+static void insert_fcn_help(const char *name, const char *str);
 static void print_help(const string &topic);
 static void print_help_topics(void);
-
-static ex lst2matrix(const ex &l);
 %}
 
 /* Tokens (T_LITERAL means a literal value returned by the parser, but not
    of class numeric or symbol (e.g. a constant or the FAIL object)) */
 %token T_NUMBER T_SYMBOL T_LITERAL T_DIGITS T_QUOTE T_QUOTE2 T_QUOTE3
-%token T_EQUAL T_NOTEQ T_LESSEQ T_GREATEREQ T_MATRIX_BEGIN T_MATRIX_END
+%token T_EQUAL T_NOTEQ T_LESSEQ T_GREATEREQ
 
-%token T_QUIT T_PRINT T_TIME T_XYZZY T_INVENTORY T_LOOK T_SCORE
+%token T_QUIT T_WARRANTY T_PRINT T_IPRINT T_PRINTLATEX T_PRINTCSRC T_TIME
+%token T_XYZZY T_INVENTORY T_LOOK T_SCORE T_COMPLEX_SYMBOLS T_REAL_SYMBOLS
 
 /* Operator precedence and associativity */
 %right '='
 %left T_EQUAL T_NOTEQ
 %left '<' '>' T_LESSEQ T_GREATEREQ
 %left '+' '-'
-%left '*' '/' '%'
+%left '*' '/'
 %nonassoc NEG
 %right '^'
 %nonassoc '!'
@@ -124,21 +156,69 @@ line      : ';'
                try {
                        push($1);
                } catch (exception &e) {
-                       cerr << e.what() << endl;
+                       std::cerr << e.what() << endl;
                        YYERROR;
                }
        }
        | T_PRINT '(' exp ')' ';' {
                try {
-                       $3.printtree(cout);
+                       $3.print(print_tree(std::cout));
+               } catch (exception &e) {
+                       std::cerr << e.what() << endl;
+                       YYERROR;
+               }
+       }
+       | T_IPRINT '(' exp ')' ';' {
+               try {
+                       ex e = $3;
+                       if (!e.info(info_flags::integer))
+                               throw (std::invalid_argument("argument to iprint() must be an integer"));
+                       long i = ex_to<numeric>(e).to_long();
+                       cout << i << endl;
+                       cout << "#o" << oct << i << endl;
+                       cout << "#x" << hex << i << dec << endl;
                } catch (exception &e) {
                        cerr << e.what() << endl;
                        YYERROR;
                }
        }
-       | '?' T_SYMBOL          {print_help(ex_to_symbol($2).getname());}
+       | T_PRINTLATEX '(' exp ')' ';' {
+               try {
+                       $3.print(print_latex(std::cout)); cout << endl;
+               } catch (exception &e) {
+                       std::cerr << e.what() << endl;
+                       YYERROR;
+               }
+       }
+       | T_PRINTCSRC '(' exp ')' ';' {
+               try {
+                       $3.print(print_csrc_double(std::cout)); cout << endl;
+               } catch (exception &e) {
+                       std::cerr << e.what() << endl;
+                       YYERROR;
+               }
+       }
+       | '?' T_SYMBOL          {print_help(ex_to<symbol>($2).get_name());}
+       | '?' T_TIME            {print_help("time");}
+       | '?' T_PRINT           {print_help("print");}
+       | '?' T_IPRINT          {print_help("iprint");}
+       | '?' T_PRINTLATEX      {print_help("print_latex");}
+       | '?' T_PRINTCSRC       {print_help("print_csrc");}
        | '?' '?'               {print_help_topics();}
        | T_QUIT                {YYACCEPT;}
+       | T_WARRANTY {
+               cout << "This program is free software; you can redistribute it and/or modify it under\n";
+               cout << "the terms of the GNU General Public License as published by the Free Software\n";
+               cout << "Foundation; either version 2 of the License, or (at your option) any later\n";
+               cout << "version.\n";
+               cout << "This program is distributed in the hope that it will be useful, but WITHOUT\n";
+               cout << "ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS\n";
+               cout << "FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more\n";
+               cout << "details.\n";
+               cout << "You should have received a copy of the GNU General Public License along with\n";
+               cout << "this program. If not, write to the Free Software Foundation, 675 Mass Ave,\n";
+               cout << "Cambridge, MA 02139, USA.\n";
+       }
        | T_XYZZY               {cout << "Nothing happens.\n";}
        | T_INVENTORY           {cout << "You're not carrying anything.\n";}
        | T_LOOK                {cout << "You're in a twisty little maze of passages, all alike.\n";}
@@ -147,6 +227,9 @@ line        : ';'
                cout << (syms.size() > 350 ? 350 : syms.size());
                cout << " out of a possible 350.\n";
        }
+       | T_REAL_SYMBOLS { symboltype = domain::real; }
+       | T_COMPLEX_SYMBOLS { symboltype = domain::complex; }
+       | T_TIME { START_TIMER } '(' exp ')' { STOP_TIMER PRINT_TIME_USED }
        | error ';'             {yyclearin; yyerrok;}
        | error ':'             {yyclearin; yyerrok;}
        ;
@@ -159,23 +242,16 @@ exp       : T_NUMBER              {$$ = $1;}
        | T_QUOTE               {$$ = exstack[0];}
        | T_QUOTE2              {$$ = exstack[1];}
        | T_QUOTE3              {$$ = exstack[2];}
-       | T_TIME {getrusage(RUSAGE_SELF, &start_time);} '(' exp ')' {
-               getrusage(RUSAGE_SELF, &end_time);
-               $$ = (end_time.ru_utime.tv_sec - start_time.ru_utime.tv_sec) +
-                    (end_time.ru_stime.tv_sec - start_time.ru_stime.tv_sec) +
-                    double(end_time.ru_utime.tv_usec - start_time.ru_utime.tv_usec) / 1e6 +
-                    double(end_time.ru_stime.tv_usec - start_time.ru_stime.tv_usec) / 1e6;
-       }
        | T_SYMBOL '(' exprseq ')' {
                fcn_tab::const_iterator i = find_function($1, $3.nops());
                if (i->second.is_ginac) {
-                       $$ = ((fcnp2)(i->second.p))(static_cast<const exprseq &>(*($3.bp)), i->second.serial);
+                       $$ = ((fcnp2)(i->second.p))(ex_to<exprseq>($3), i->second.serial);
                } else {
-                       $$ = (i->second.p)(static_cast<const exprseq &>(*($3.bp)));
+                       $$ = (i->second.p)(ex_to<exprseq>($3));
                }
        }
-       | T_DIGITS '=' T_NUMBER {$$ = $3; Digits = ex_to_numeric($3).to_int();}
-       | T_SYMBOL '=' exp      {$$ = $3; const_cast<symbol *>(&ex_to_symbol($1))->assign($3);}
+       | T_DIGITS '=' T_NUMBER {$$ = $3; Digits = ex_to<numeric>($3).to_int();}
+       | T_SYMBOL '=' exp      {$$ = $3; const_cast<symbol&>(ex_to<symbol>($1)).assign($3);}
        | exp T_EQUAL exp       {$$ = $1 == $3;}
        | exp T_NOTEQ exp       {$$ = $1 != $3;}
        | exp '<' exp           {$$ = $1 < $3;}
@@ -186,18 +262,17 @@ exp       : T_NUMBER              {$$ = $1;}
        | exp '-' exp           {$$ = $1 - $3;}
        | exp '*' exp           {$$ = $1 * $3;}
        | exp '/' exp           {$$ = $1 / $3;}
-       | exp '%' exp           {$$ = $1 % $3;}
        | '-' exp %prec NEG     {$$ = -$2;}
        | '+' exp %prec NEG     {$$ = $2;}
        | exp '^' exp           {$$ = power($1, $3);}
        | exp '!'               {$$ = factorial($1);}
        | '(' exp ')'           {$$ = $2;}
-       | '[' list_or_empty ']' {$$ = $2;}
-       | T_MATRIX_BEGIN matrix T_MATRIX_END    {$$ = lst2matrix($2);}
+       | '{' list_or_empty '}' {$$ = $2;}
+       | '[' matrix ']'        {$$ = lst_to_matrix(ex_to<lst>($2));}
        ;
 
 exprseq        : exp                   {$$ = exprseq($1);}
-       | exprseq ',' exp       {exprseq es(static_cast<exprseq &>(*($1.bp))); $$ = es.append($3);}
+       | exprseq ',' exp       {exprseq es(ex_to<exprseq>($1)); $$ = es.append($3);}
        ;
 
 list_or_empty: /* empty */     {$$ = *new lst;}
@@ -205,15 +280,15 @@ list_or_empty: /* empty */        {$$ = *new lst;}
        ;
 
 list   : exp                   {$$ = lst($1);}
-       | list ',' exp          {lst l(static_cast<lst &>(*($1.bp))); $$ = l.append($3);}
+       | list ',' exp          {lst l(ex_to<lst>($1)); $$ = l.append($3);}
        ;
 
-matrix : T_MATRIX_BEGIN row T_MATRIX_END               {$$ = lst($2);}
-       | matrix ',' T_MATRIX_BEGIN row T_MATRIX_END    {lst l(static_cast<lst &>(*($1.bp))); $$ = l.append($4);}
+matrix : '[' row ']'           {$$ = lst($2);}
+       | matrix ',' '[' row ']' {lst l(ex_to<lst>($1)); $$ = l.append($4);}
        ;
 
 row    : exp                   {$$ = lst($1);}
-       | row ',' exp           {lst l(static_cast<lst &>(*($1.bp))); $$ = l.append($3);}
+       | row ',' exp           {lst l(ex_to<lst>($1)); $$ = l.append($3);}
        ;
 
 
@@ -242,66 +317,103 @@ static void push(const ex &e)
  *  Built-in functions
  */
 
-static ex f_beta(const exprseq &e) {return gamma(e[0])*gamma(e[1])/gamma(e[0]+e[1]);}
+static ex f_abs(const exprseq &e) {return abs(e[0]);}
+static ex f_acos(const exprseq &e) {return acos(e[0]);}
+static ex f_acosh(const exprseq &e) {return acosh(e[0]);}
+static ex f_asin(const exprseq &e) {return asin(e[0]);}
+static ex f_asinh(const exprseq &e) {return asinh(e[0]);}
+static ex f_atan(const exprseq &e) {return atan(e[0]);}
+static ex f_atan2(const exprseq &e) {return atan2(e[0], e[1]);}
+static ex f_atanh(const exprseq &e) {return atanh(e[0]);}
+static ex f_beta(const exprseq &e) {return beta(e[0], e[1]);}
+static ex f_binomial(const exprseq &e) {return binomial(e[0], e[1]);}
+static ex f_collect(const exprseq &e) {return e[0].collect(e[1]);}
+static ex f_collect_distributed(const exprseq &e) {return e[0].collect(e[1], true);}
+static ex f_collect_common_factors(const exprseq &e) {return collect_common_factors(e[0]);}
+static ex f_convert_H_to_Li(const exprseq &e) {return convert_H_to_Li(e[0], e[1]);}
+static ex f_cos(const exprseq &e) {return cos(e[0]);}
+static ex f_cosh(const exprseq &e) {return cosh(e[0]);}
+static ex f_degree(const exprseq &e) {return e[0].degree(e[1]);}
 static ex f_denom(const exprseq &e) {return e[0].denom();}
+static ex f_function_derivative(const exprseq &e) {return function_derivative(e[0], e[1]);}
+static ex f_eta(const exprseq &e) {return eta(e[0], e[1]);}
 static ex f_eval1(const exprseq &e) {return e[0].eval();}
 static ex f_evalf1(const exprseq &e) {return e[0].evalf();}
+static ex f_evalm(const exprseq &e) {return e[0].evalm();}
+static ex f_eval_integ(const exprseq &e) {return e[0].eval_integ();}
+static ex f_exp(const exprseq &e) {return exp(e[0]);}
 static ex f_expand(const exprseq &e) {return e[0].expand();}
+static ex f_factorial(const exprseq &e) {return factorial(e[0]);}
+static ex f_G2(const exprseq &e) {return G(e[0], e[1]);}
+static ex f_G3(const exprseq &e) {return G(e[0], e[1], e[2]);}
 static ex f_gcd(const exprseq &e) {return gcd(e[0], e[1]);}
+static ex f_H(const exprseq &e) {return H(e[0], e[1]);}
+static ex f_has(const exprseq &e) {return e[0].has(e[1]) ? ex(1) : ex(0);}
 static ex f_lcm(const exprseq &e) {return lcm(e[0], e[1]);}
+static ex f_lcoeff(const exprseq &e) {return e[0].lcoeff(e[1]);}
+static ex f_ldegree(const exprseq &e) {return e[0].ldegree(e[1]);}
+static ex f_lgamma(const exprseq &e) {return lgamma(e[0]);}
+static ex f_Li2(const exprseq &e) {return Li(2, e[0]);}
+static ex f_Li3(const exprseq &e) {return Li(3, e[0]);}
+static ex f_Li(const exprseq &e) {return Li(e[0], e[1]);}
+static ex f_log(const exprseq &e) {return log(e[0]);}
 static ex f_lsolve(const exprseq &e) {return lsolve(e[0], e[1]);}
 static ex f_nops(const exprseq &e) {return e[0].nops();}
 static ex f_normal1(const exprseq &e) {return e[0].normal();}
 static ex f_numer(const exprseq &e) {return e[0].numer();}
-static ex f_power(const exprseq &e) {return power(e[0], e[1]);}
+static ex f_numer_denom(const exprseq &e) {return e[0].numer_denom();}
+static ex f_Order(const exprseq &e) {return Order(e[0]);}
+static ex f_pow(const exprseq &e) {return pow(e[0], e[1]);}
+static ex f_psi1(const exprseq &e) {return psi(e[0]);}
+static ex f_psi2(const exprseq &e) {return psi(e[0], e[1]);}
+static ex f_S(const exprseq &e) {return S(e[0], e[1], e[2]);}
+static ex f_sin(const exprseq &e) {return sin(e[0]);}
+static ex f_sinh(const exprseq &e) {return sinh(e[0]);}
 static ex f_sqrt(const exprseq &e) {return sqrt(e[0]);}
+static ex f_sqrfree1(const exprseq &e) {return sqrfree(e[0]);}
 static ex f_subs2(const exprseq &e) {return e[0].subs(e[1]);}
+static ex f_tan(const exprseq &e) {return tan(e[0]);}
+static ex f_tanh(const exprseq &e) {return tanh(e[0]);}
+static ex f_tcoeff(const exprseq &e) {return e[0].tcoeff(e[1]);}
+static ex f_tgamma(const exprseq &e) {return tgamma(e[0]);}
+static ex f_zeta1(const exprseq &e) {return zeta(e[0]);}
+static ex f_zeta2(const exprseq &e) {return zeta(e[0], e[1]);}
 
-#define CHECK_ARG(num, type, fcn) if (!is_ex_of_type(e[num], type)) throw(std::invalid_argument("argument " #num " to " #fcn " must be a " #type))
+#define CHECK_ARG(num, type, fcn) if (!is_a<type>(e[num])) throw(std::invalid_argument("argument " #num " to " #fcn "() must be a " #type))
 
 static ex f_charpoly(const exprseq &e)
 {
        CHECK_ARG(0, matrix, charpoly);
-       CHECK_ARG(1, symbol, charpoly);
-       return ex_to_matrix(e[0]).charpoly(ex_to_symbol(e[1]));
+       return ex_to<matrix>(e[0]).charpoly(e[1]);
 }
 
 static ex f_coeff(const exprseq &e)
 {
-       CHECK_ARG(1, symbol, coeff);
        CHECK_ARG(2, numeric, coeff);
-       return e[0].coeff(ex_to_symbol(e[1]), ex_to_numeric(e[2]).to_int());
-}
-
-static ex f_collect(const exprseq &e)
-{
-       CHECK_ARG(1, symbol, collect);
-       return e[0].collect(ex_to_symbol(e[1]));
+       return e[0].coeff(e[1], ex_to<numeric>(e[2]).to_int());
 }
 
 static ex f_content(const exprseq &e)
 {
-       CHECK_ARG(1, symbol, content);
-       return e[0].content(ex_to_symbol(e[1]));
+       return e[0].content(e[1]);
 }
 
-static ex f_degree(const exprseq &e)
+static ex f_decomp_rational(const exprseq &e)
 {
-       CHECK_ARG(1, symbol, degree);
-       return e[0].degree(ex_to_symbol(e[1]));
+       return decomp_rational(e[0], e[1]);
 }
 
 static ex f_determinant(const exprseq &e)
 {
        CHECK_ARG(0, matrix, determinant);
-       return ex_to_matrix(e[0]).determinant();
+       return ex_to<matrix>(e[0]).determinant();
 }
 
 static ex f_diag(const exprseq &e)
 {
-       int dim = e.nops();
+       size_t dim = e.nops();
        matrix &m = *new matrix(dim, dim);
-       for (int i=0; i<dim; i++)
+       for (size_t i=0; i<dim; i++)
                m.set(i, i, e.op(i));
        return m;
 }
@@ -309,14 +421,14 @@ static ex f_diag(const exprseq &e)
 static ex f_diff2(const exprseq &e)
 {
        CHECK_ARG(1, symbol, diff);
-       return e[0].diff(ex_to_symbol(e[1]));
+       return e[0].diff(ex_to<symbol>(e[1]));
 }
 
 static ex f_diff3(const exprseq &e)
 {
        CHECK_ARG(1, symbol, diff);
        CHECK_ARG(2, numeric, diff);
-       return e[0].diff(ex_to_symbol(e[1]), ex_to_numeric(e[2]).to_int());
+       return e[0].diff(ex_to<symbol>(e[1]), ex_to<numeric>(e[2]).to_int());
 }
 
 static ex f_divide(const exprseq &e)
@@ -325,150 +437,175 @@ static ex f_divide(const exprseq &e)
        if (divide(e[0], e[1], q))
                return q;
        else
-               return *new fail();
+               return fail();
 }
 
 static ex f_eval2(const exprseq &e)
 {
        CHECK_ARG(1, numeric, eval);
-       return e[0].eval(ex_to_numeric(e[1]).to_int());
+       return e[0].eval(ex_to<numeric>(e[1]).to_int());
 }
 
 static ex f_evalf2(const exprseq &e)
 {
        CHECK_ARG(1, numeric, evalf);
-       return e[0].evalf(ex_to_numeric(e[1]).to_int());
+       return e[0].evalf(ex_to<numeric>(e[1]).to_int());
 }
 
-static ex f_has(const exprseq &e)
+static ex f_find(const exprseq &e)
 {
-       return e[0].has(e[1]) ? exONE() : exZERO();
+       lst found;
+       e[0].find(e[1], found);
+       return found;
+}
+
+static ex f_fsolve(const exprseq &e)
+{
+       CHECK_ARG(1, symbol, fsolve);
+       CHECK_ARG(2, numeric, fsolve);
+       CHECK_ARG(3, numeric, fsolve);
+       return fsolve(e[0], ex_to<symbol>(e[1]), ex_to<numeric>(e[2]), ex_to<numeric>(e[3]));
+}
+
+static ex f_integer_content(const exprseq &e)
+{
+       return e[0].expand().integer_content();
+}
+
+static ex f_integral(const exprseq &e)
+{
+       CHECK_ARG(0, symbol, integral);
+       return integral(e[0], e[1], e[2], e[3]);
 }
 
 static ex f_inverse(const exprseq &e)
 {
        CHECK_ARG(0, matrix, inverse);
-       return ex_to_matrix(e[0]).inverse();
+       return ex_to<matrix>(e[0]).inverse();
 }
 
 static ex f_is(const exprseq &e)
 {
        CHECK_ARG(0, relational, is);
-       return (bool)ex_to_relational(e[0]) ? exONE() : exZERO();
+       return (bool)ex_to<relational>(e[0]) ? ex(1) : ex(0);
 }
 
-static ex f_lcoeff(const exprseq &e)
+class apply_map_function : public map_function {
+       ex apply;
+public:
+       apply_map_function(const ex & a) : apply(a) {}
+       virtual ~apply_map_function() {}
+       ex operator()(const ex & e) { return apply.subs(wild() == e, true); }
+};
+
+static ex f_map(const exprseq &e)
 {
-       CHECK_ARG(1, symbol, lcoeff);
-       return e[0].lcoeff(ex_to_symbol(e[1]));
+       apply_map_function fcn(e[1]);
+       return e[0].map(fcn);
 }
 
-static ex f_ldegree(const exprseq &e)
+static ex f_match(const exprseq &e)
 {
-       CHECK_ARG(1, symbol, ldegree);
-       return e[0].ldegree(ex_to_symbol(e[1]));
+       lst repl_lst;
+       if (e[0].match(e[1], repl_lst))
+               return repl_lst;
+       else
+               return fail();
 }
 
 static ex f_normal2(const exprseq &e)
 {
        CHECK_ARG(1, numeric, normal);
-       return e[0].normal(ex_to_numeric(e[1]).to_int());
+       return e[0].normal(ex_to<numeric>(e[1]).to_int());
 }
 
 static ex f_op(const exprseq &e)
 {
        CHECK_ARG(1, numeric, op);
-       int n = ex_to_numeric(e[1]).to_int();
-       if (n < 0 || n >= e[0].nops())
+       int n = ex_to<numeric>(e[1]).to_int();
+       if (n < 0 || n >= (int)e[0].nops())
                throw(std::out_of_range("second argument to op() is out of range"));
        return e[0].op(n);
 }
 
 static ex f_prem(const exprseq &e)
 {
-       CHECK_ARG(2, symbol, prem);
-       return prem(e[0], e[1], ex_to_symbol(e[2]));
+       return prem(e[0], e[1], e[2]);
 }
 
 static ex f_primpart(const exprseq &e)
 {
-       CHECK_ARG(1, symbol, primpart);
-       return e[0].primpart(ex_to_symbol(e[1]));
+       return e[0].primpart(e[1]);
 }
 
 static ex f_quo(const exprseq &e)
 {
-       CHECK_ARG(2, symbol, quo);
-       return quo(e[0], e[1], ex_to_symbol(e[2]));
+       return quo(e[0], e[1], e[2]);
+}
+
+static ex f_rank(const exprseq &e)
+{
+       CHECK_ARG(0, matrix, rank);
+       return ex_to<matrix>(e[0]).rank();
 }
 
 static ex f_rem(const exprseq &e)
 {
-       CHECK_ARG(2, symbol, rem);
-       return rem(e[0], e[1], ex_to_symbol(e[2]));
+       return rem(e[0], e[1], e[2]);
 }
 
-static ex f_series2(const exprseq &e)
+static ex f_resultant(const exprseq &e)
 {
-       CHECK_ARG(1, symbol, series);
-       return e[0].series(ex_to_symbol(e[1]), exZERO());
+       CHECK_ARG(2, symbol, resultant);
+       return resultant(e[0], e[1], ex_to<symbol>(e[2]));
 }
 
-static ex f_series3(const exprseq &e)
+static ex f_series(const exprseq &e)
 {
-       CHECK_ARG(1, symbol, series);
-       return e[0].series(ex_to_symbol(e[1]), e[2]);
+       CHECK_ARG(2, numeric, series);
+       return e[0].series(e[1], ex_to<numeric>(e[2]).to_int());
 }
 
-static ex f_series4(const exprseq &e)
+static ex f_sprem(const exprseq &e)
 {
-       CHECK_ARG(1, symbol, series);
-       CHECK_ARG(3, numeric, series);
-       return e[0].series(ex_to_symbol(e[1]), e[2], ex_to_numeric(e[3]).to_int());
+       return sprem(e[0], e[1], e[2]);
 }
 
-static ex f_sqrfree(const exprseq &e)
+static ex f_sqrfree2(const exprseq &e)
 {
-       CHECK_ARG(1, symbol, sqrfree);
-       return sqrfree(e[0], ex_to_symbol(e[1]));
+       CHECK_ARG(1, lst, sqrfree);
+       return sqrfree(e[0], ex_to<lst>(e[1]));
 }
 
 static ex f_subs3(const exprseq &e)
 {
        CHECK_ARG(1, lst, subs);
        CHECK_ARG(2, lst, subs);
-       return e[0].subs(ex_to_lst(e[1]), ex_to_lst(e[2]));
-}
-
-static ex f_tcoeff(const exprseq &e)
-{
-       CHECK_ARG(1, symbol, tcoeff);
-       return e[0].tcoeff(ex_to_symbol(e[1]));
+       return e[0].subs(ex_to<lst>(e[1]), ex_to<lst>(e[2]));
 }
 
 static ex f_trace(const exprseq &e)
 {
        CHECK_ARG(0, matrix, trace);
-       return ex_to_matrix(e[0]).trace();
+       return ex_to<matrix>(e[0]).trace();
 }
 
 static ex f_transpose(const exprseq &e)
 {
        CHECK_ARG(0, matrix, transpose);
-       return ex_to_matrix(e[0]).transpose();
+       return ex_to<matrix>(e[0]).transpose();
 }
 
 static ex f_unassign(const exprseq &e)
 {
        CHECK_ARG(0, symbol, unassign);
-       (const_cast<symbol *>(&ex_to_symbol(e[0])))->unassign();
+       const_cast<symbol&>(ex_to<symbol>(e[0])).unassign();
        return e[0];
 }
 
 static ex f_unit(const exprseq &e)
 {
-       CHECK_ARG(1, symbol, unit);
-       return e[0].unit(ex_to_symbol(e[1]));
+       return e[0].unit(e[1]);
 }
 
 static ex f_dummy(const exprseq &e)
@@ -476,64 +613,158 @@ static ex f_dummy(const exprseq &e)
        throw(std::logic_error("dummy function called (shouldn't happen)"));
 }
 
-// Table for initializing the "fcns" map
+// Tables for initializing the "fcns" map and the function help topics
 struct fcn_init {
        const char *name;
-       const fcn_desc desc;
+       fcnp p;
+       int num_params;
 };
 
 static const fcn_init builtin_fcns[] = {
-       {"beta", fcn_desc(f_beta, 2)},
-       {"charpoly", fcn_desc(f_charpoly, 2)},
-       {"coeff", fcn_desc(f_coeff, 3)},
-       {"collect", fcn_desc(f_collect, 2)},
-       {"content", fcn_desc(f_content, 2)},
-       {"degree", fcn_desc(f_degree, 2)},
-       {"denom", fcn_desc(f_denom, 1)},
-       {"determinant", fcn_desc(f_determinant, 1)},
-       {"diag", fcn_desc(f_diag, 0)},
-       {"diff", fcn_desc(f_diff2, 2)},
-       {"diff", fcn_desc(f_diff3, 3)},
-       {"divide", fcn_desc(f_divide, 2)},
-       {"eval", fcn_desc(f_eval1, 1)},
-       {"eval", fcn_desc(f_eval2, 2)},
-       {"evalf", fcn_desc(f_evalf1, 1)},
-       {"evalf", fcn_desc(f_evalf2, 2)},
-       {"expand", fcn_desc(f_expand, 1)},
-       {"gcd", fcn_desc(f_gcd, 2)},
-       {"has", fcn_desc(f_has, 2)},
-       {"inverse", fcn_desc(f_inverse, 1)},
-       {"is", fcn_desc(f_is, 1)},
-       {"lcm", fcn_desc(f_lcm, 2)},
-       {"lcoeff", fcn_desc(f_lcoeff, 2)},
-       {"ldegree", fcn_desc(f_ldegree, 2)},
-       {"lsolve", fcn_desc(f_lsolve, 2)},
-       {"nops", fcn_desc(f_nops, 1)},
-       {"normal", fcn_desc(f_normal1, 1)},
-       {"normal", fcn_desc(f_normal2, 2)},
-       {"numer", fcn_desc(f_numer, 1)},
-       {"op", fcn_desc(f_op, 2)},
-       {"power", fcn_desc(f_power, 2)},
-       {"prem", fcn_desc(f_prem, 3)},
-       {"primpart", fcn_desc(f_primpart, 2)},
-       {"quo", fcn_desc(f_quo, 3)},
-       {"rem", fcn_desc(f_rem, 3)},
-       {"series", fcn_desc(f_series2, 2)},
-       {"series", fcn_desc(f_series3, 3)},
-       {"series", fcn_desc(f_series4, 4)},
-       {"sqrfree", fcn_desc(f_sqrfree, 2)},
-       {"sqrt", fcn_desc(f_sqrt, 1)},
-       {"subs", fcn_desc(f_subs2, 2)},
-       {"subs", fcn_desc(f_subs3, 3)},
-       {"tcoeff", fcn_desc(f_tcoeff, 2)},
-       {"time", fcn_desc(f_dummy, 0)},
-       {"trace", fcn_desc(f_trace, 1)},
-       {"transpose", fcn_desc(f_transpose, 1)},
-       {"unassign", fcn_desc(f_unassign, 1)},
-       {"unit", fcn_desc(f_unit, 2)},
-       {NULL, fcn_desc(f_dummy, 0)}    // End marker
+       {"abs", f_abs, 1},
+       {"acos", f_acos, 1},
+       {"acosh", f_acosh, 1},
+       {"asin", f_asin, 1},
+       {"asinh", f_asinh, 1},
+       {"atan", f_atan, 1},
+       {"atan2", f_atan2, 2},
+       {"atanh", f_atanh, 1},
+       {"beta", f_beta, 2},
+       {"binomial", f_binomial, 2},
+       {"charpoly", f_charpoly, 2},
+       {"coeff", f_coeff, 3},
+       {"collect", f_collect, 2},
+       {"collect_common_factors", f_collect_common_factors, 1},
+       {"collect_distributed", f_collect_distributed, 2},
+       {"content", f_content, 2},
+       {"convert_H_to_Li", f_convert_H_to_Li, 2},
+       {"cos", f_cos, 1},
+       {"cosh", f_cosh, 1},
+       {"decomp_rational", f_decomp_rational, 2},
+       {"degree", f_degree, 2},
+       {"denom", f_denom, 1},
+       {"Derivative", f_function_derivative, 2},
+       {"determinant", f_determinant, 1},
+       {"diag", f_diag, 0},
+       {"diff", f_diff2, 2},
+       {"diff", f_diff3, 3},
+       {"divide", f_divide, 2},
+       {"eta", f_eta, 2},
+       {"eval", f_eval1, 1},
+       {"eval", f_eval2, 2},
+       {"evalf", f_evalf1, 1},
+       {"evalf", f_evalf2, 2},
+       {"evalm", f_evalm, 1},
+       {"eval_integ", f_eval_integ, 1},
+       {"exp", f_exp, 1},
+       {"expand", f_expand, 1},
+       {"factorial", f_factorial, 1},
+       {"find", f_find, 2},
+       {"fsolve", f_fsolve, 4},
+       {"G", f_G2, 2},
+       {"G", f_G3, 3},
+       {"gcd", f_gcd, 2},
+       {"H", f_H, 2},
+       {"has", f_has, 2},
+       {"integer_content", f_integer_content, 1},
+       {"integral", f_integral, 4},
+       {"inverse", f_inverse, 1},
+       {"iprint", f_dummy, 0},      // for Tab-completion
+       {"is", f_is, 1},
+       {"lcm", f_lcm, 2},
+       {"lcoeff", f_lcoeff, 2},
+       {"ldegree", f_ldegree, 2},
+       {"lgamma", f_lgamma, 1},
+       {"Li2", f_Li2, 1},
+       {"Li3", f_Li3, 1},
+       {"Li", f_Li, 2},
+       {"log", f_log, 1},
+       {"lsolve", f_lsolve, 2},
+       {"map", f_map, 2},
+       {"match", f_match, 2},
+       {"nops", f_nops, 1},
+       {"normal", f_normal1, 1},
+       {"normal", f_normal2, 2},
+       {"numer", f_numer, 1},
+       {"numer_denom", f_numer_denom, 1},
+       {"op", f_op, 2},
+       {"Order", f_Order, 1},
+       {"pow", f_pow, 2},
+       {"prem", f_prem, 3},
+       {"primpart", f_primpart, 2},
+       {"print", f_dummy, 0},       // for Tab-completion
+       {"print_csrc", f_dummy, 0},  // for Tab-completion
+       {"print_latex", f_dummy, 0}, // for Tab-completion
+       {"psi", f_psi1, 1},
+       {"psi", f_psi2, 2},
+       {"quo", f_quo, 3},
+       {"rank", f_rank, 1},
+       {"rem", f_rem, 3},
+       {"resultant", f_resultant, 3},
+       {"S", f_S, 3},
+       {"series", f_series, 3},
+       {"sin", f_sin, 1},
+       {"sinh", f_sinh, 1},
+       {"sprem", f_sprem, 3},
+       {"sqrfree", f_sqrfree1, 1},
+       {"sqrfree", f_sqrfree2, 2},
+       {"sqrt", f_sqrt, 1},
+       {"subs", f_subs2, 2},
+       {"subs", f_subs3, 3},
+       {"tan", f_tan, 1},
+       {"tanh", f_tanh, 1},
+       {"tcoeff", f_tcoeff, 2},
+       {"tgamma", f_tgamma, 1},
+       {"time", f_dummy, 0},        // for Tab-completion
+       {"trace", f_trace, 1},
+       {"transpose", f_transpose, 1},
+       {"unassign", f_unassign, 1},
+       {"unit", f_unit, 2},
+       {"zeta", f_zeta1, 1},
+       {"zeta", f_zeta2, 2},
+       {NULL, f_dummy, 0}           // End marker
 };
 
+struct fcn_help_init {
+       const char *name;
+       const char *help;
+};
+
+static const fcn_help_init builtin_help[] = {
+       {"acos", "inverse cosine function"},
+       {"acosh", "inverse hyperbolic cosine function"},
+       {"asin", "inverse sine function"},
+       {"asinh", "inverse hyperbolic sine function"},
+       {"atan", "inverse tangent function"},
+       {"atan2", "inverse tangent function with two arguments"},
+       {"atanh", "inverse hyperbolic tangent function"},
+       {"beta", "Beta function"},
+       {"binomial", "binomial function"},
+       {"cos", "cosine function"},
+       {"cosh", "hyperbolic cosine function"},
+       {"exp", "exponential function"},
+       {"factorial", "factorial function"},
+       {"lgamma", "natural logarithm of Gamma function"},
+       {"tgamma", "Gamma function"},
+       {"log", "natural logarithm"},
+       {"psi", "psi function\npsi(x) is the digamma function, psi(n,x) the nth polygamma function"},
+       {"sin", "sine function"},
+       {"sinh", "hyperbolic sine function"},
+       {"tan", "tangent function"},
+       {"tanh", "hyperbolic tangent function"},
+       {"zeta", "zeta function\nzeta(x) is Riemann's zeta function, zetaderiv(n,x) its nth derivative.\nIf x is a GiNaC::lst, it is a multiple zeta value\nzeta(x,s) is an alternating Euler sum"},
+       {"Li2", "dilogarithm"},
+       {"Li3", "trilogarithm"},
+       {"Li", "(multiple) polylogarithm"},
+       {"S", "Nielsen's generalized polylogarithm"},
+       {"H", "harmonic polylogarithm"},
+       {"Order", "order term function (for truncated power series)"},
+       {"Derivative", "inert differential operator"},
+       {NULL, NULL}    // End marker
+};
+
+#include "ginsh_extensions.h"
+
 
 /*
  *  Add functions to ginsh
@@ -543,36 +774,18 @@ static const fcn_init builtin_fcns[] = {
 static void insert_fcns(const fcn_init *p)
 {
        while (p->name) {
-               fcns.insert(make_pair(string(p->name), p->desc));
+               fcns.insert(make_pair(string(p->name), fcn_desc(p->p, p->num_params)));
                p++;
        }
 }
 
-static ex f_ginac_function(const exprseq &es, int serial)
-{
-       return function(serial, es).eval(1);
-}
-
-// All registered GiNaC functions
-void GiNaC::ginsh_get_ginac_functions(void)
-{
-       vector<registered_function_info>::const_iterator i = function::registered_functions().begin(), end = function::registered_functions().end();
-       unsigned serial = 0;
-       while (i != end) {
-               fcns.insert(make_pair(i->name, fcn_desc(f_ginac_function, i->nparams, serial)));
-               i++;
-               serial++;
-       }
-}
-
-
 /*
  *  Find a function given a name and number of parameters. Throw exceptions on error.
  */
 
 static fcn_tab::const_iterator find_function(const ex &sym, int req_params)
 {
-       const string &name = ex_to_symbol(sym).getname();
+       const string &name = ex_to<symbol>(sym).get_name();
        typedef fcn_tab::const_iterator I;
        pair<I, I> b = fcns.equal_range(name);
        if (b.first == b.second)
@@ -614,6 +827,15 @@ static void insert_fcn_help(const char *name, const char *str)
        }
 }
 
+// Help strings for functions from fcn_help_init array
+static void insert_help(const fcn_help_init *p)
+{
+       while (p->name) {
+               insert_fcn_help(p->name, p->help);
+               p++;
+       }
+}
+
 
 /*
  *  Print help to cout
@@ -653,38 +875,11 @@ static void print_help_topics(void)
 }
 
 
-/*
- *  Convert list of lists to matrix
- */
-
-static ex lst2matrix(const ex &l)
-{
-       if (!is_ex_of_type(l, lst))
-               throw(std::logic_error("internal error: argument to lst2matrix() is not a list"));
-
-       // Find number of rows and columns
-       int rows = l.nops(), cols = 0, i, j;
-       for (i=0; i<rows; i++)
-               if (l.op(i).nops() > cols)
-                       cols = l.op(i).nops();
-
-       // Allocate and fill matrix
-       matrix &m = *new matrix(rows, cols);
-       for (i=0; i<rows; i++)
-               for (j=0; j<cols; j++)
-                       if (l.op(i).nops() > j)
-                               m.set(i, j, l.op(i).op(j));
-                       else
-                               m.set(i, j, exZERO());
-       return m;
-}
-
-
 /*
  *  Function name completion functions for readline
  */
 
-static char *fcn_generator(char *text, int state)
+static char *fcn_generator(const char *text, int state)
 {
        static int len;                         // Length of word to complete
        static fcn_tab::const_iterator index;   // Iterator to function being currently considered
@@ -698,28 +893,47 @@ static char *fcn_generator(char *text, int state)
        // Return the next function which partially matches
        while (index != fcns.end()) {
                const char *fcn_name = index->first.c_str();
-               index++;
+               ++index;
                if (strncmp(fcn_name, text, len) == 0)
                        return strdup(fcn_name);
        }
        return NULL;
 }
 
-static char **fcn_completion(char *text, int start, int end)
+static char **fcn_completion(const char *text, int start, int end)
 {
        if (rl_line_buffer[0] == '!') {
                // For shell commands, revert back to filename completion
                rl_completion_append_character = orig_completion_append_character;
                rl_basic_word_break_characters = orig_basic_word_break_characters;
-               return completion_matches(text, filename_completion_function);
+               rl_completer_word_break_characters = GINAC_RL_COMPLETER_CAST(rl_basic_word_break_characters);
+#if (GINAC_RL_VERSION_MAJOR < 4) || (GINAC_RL_VERSION_MAJOR == 4 && GINAC_RL_VERSION_MINOR < 2)
+               return completion_matches(const_cast<char *>(text), (CPFunction *)filename_completion_function);
+#else
+               return rl_completion_matches(text, rl_filename_completion_function);
+#endif
        } else {
                // Otherwise, complete function names
                rl_completion_append_character = '(';
                rl_basic_word_break_characters = " \t\n\"#$%&'()*+,-./:;<=>?@[\\]^`{|}~";
-               return completion_matches(text, fcn_generator);
+               rl_completer_word_break_characters = GINAC_RL_COMPLETER_CAST(rl_basic_word_break_characters);
+#if (GINAC_RL_VERSION_MAJOR < 4) || (GINAC_RL_VERSION_MAJOR == 4 && GINAC_RL_VERSION_MINOR < 2)
+               return completion_matches(const_cast<char *>(text), (CPFunction *)fcn_generator);
+#else
+               return rl_completion_matches(text, fcn_generator);
+#endif
        }
 }
 
+void greeting(void)
+{
+    cout << "ginsh - GiNaC Interactive Shell (" << PACKAGE << " V" << VERSION << ")" << endl;
+    cout << "  __,  _______  Copyright (C) 1999-2006 Johannes Gutenberg University Mainz,\n"
+         << " (__) *       | Germany.  This is free software with ABSOLUTELY NO WARRANTY.\n"
+         << "  ._) i N a C | You are welcome to redistribute it under certain conditions.\n"
+         << "<-------------' For details type `warranty;'.\n" << endl;
+    cout << "Type ?? for a list of help topics." << endl;
+}
 
 /*
  *  Main program
@@ -728,51 +942,37 @@ static char **fcn_completion(char *text, int start, int end)
 int main(int argc, char **argv)
 {
        // Print banner in interactive mode
-       if (isatty(0)) {
-               cout << "ginsh - GiNaC Interactive Shell (" << PACKAGE << " " << VERSION << ")\n";
-               cout << "Copyright (C) 1999 Johannes Gutenberg Universitaet Mainz, Germany\n";
-               cout << "This is free software, and you are welcome to redistribute it\n";
-               cout << "under certain conditions; see the file COPYING for details.\n";
-               cout << "Type ?? for a list of help topics.\n";
-       }
+       if (isatty(0)) 
+               greeting();
 
        // Init function table
        insert_fcns(builtin_fcns);
-       ginsh_get_ginac_functions();
+       insert_fcns(extended_fcns);
 
        // Init help for operators (automatically generated from man page)
        insert_help("operators", "Operators in falling order of precedence:");
-#include "ginsh_op_help.c"
+#include "ginsh_op_help.h"
 
        // Init help for built-in functions (automatically generated from man page)
-#include "ginsh_fcn_help.c"
+#include "ginsh_fcn_help.h"
 
        // Help for GiNaC functions is added manually
-       insert_fcn_help("acos", "inverse cosine function");
-       insert_fcn_help("acosh", "inverse hyperbolic cosine function");
-       insert_fcn_help("asin", "inverse sine function");
-       insert_fcn_help("asinh", "inverse hyperbolic sine function");
-       insert_fcn_help("atan", "inverse tangent function");
-       insert_fcn_help("atan2", "inverse tangent function with two arguments");
-       insert_fcn_help("atanh", "inverse hyperbolic tangent function");
-       insert_fcn_help("cos", "cosine function");
-       insert_fcn_help("cosh", "hyperbolic cosine function");
-       insert_fcn_help("sin", "sine function");
-       insert_fcn_help("sinh", "hyperbolic sine function");
-       insert_fcn_help("tan", "tangent function");
-       insert_fcn_help("tanh", "hyperbolic tangent function");
-       insert_fcn_help("exp", "exponential function");
-       insert_fcn_help("log", "natural logarithm");
-       insert_fcn_help("Li2", "dilogarithm");
-       insert_fcn_help("Li3", "trilogarithm");
-       insert_fcn_help("binomial", "binomial function");
-       insert_fcn_help("factorial", "factorial function");
-       insert_fcn_help("gamma", "gamma function");
-       insert_fcn_help("Order", "order term function (for truncated power series)");
+       insert_help(builtin_help);
+       insert_help(extended_help);
+
+       // Help for other keywords
+       insert_help("print", "print(expression) - dumps the internal structure of the given expression (for debugging)");
+       insert_help("iprint", "iprint(expression) - prints the given integer expression in decimal, octal, and hexadecimal bases");
+       insert_help("print_latex", "print_latex(expression) - prints a LaTeX representation of the given expression");
+       insert_help("print_csrc", "print_csrc(expression) - prints a C source code representation of the given expression");
 
        // Init readline completer
        rl_readline_name = argv[0];
+#if (GINAC_RL_VERSION_MAJOR < 4) || (GINAC_RL_VERSION_MAJOR == 4 && GINAC_RL_VERSION_MINOR < 2)
        rl_attempted_completion_function = (CPPFunction *)fcn_completion;
+#else
+       rl_attempted_completion_function = fcn_completion;
+#endif
        orig_completion_append_character = rl_completion_append_character;
        orig_basic_word_break_characters = rl_basic_word_break_characters;