/* ezunits: yet another units package for Maxima
 * This program copyright 2008 by Robert Dodier.
 * I release this program under the terms of the
 * GNU General Public License.
 */

qput (ezunits, "experimental, usable", version);

load ("ezunits.lisp");

infix ("`", 118, 118);
infix ("``", 117, 117);

declare (constvalue, evfun);

constvalue (e) :=
  if mapatom(e)
    then
     (if symbolp(e)
        then (get (e, 'constvalue), if %% # false then %% else e)
        else e)
    else map (constvalue, e);

declare_constvalue (a, x) ::= buildq ([a, x], put (a, x, 'constvalue));

/* Hold off on this display symbol business.
 * :lisp (put '$\` '(#\space #\space) 'dissym)
 */

declare (dimensional, feature);

declare_units (a%, u%) :=
  block (local (a%, u%), 
  if listp(a%)
    then map (lambda ([a1%], local(a1%), declare1_units (a1%, u%)), a%)
    else declare1_units (a%, u%), u%);

declare1_units (a%, u%) :=
  block (local (a%, u%),
  apply ('define_variable, [a%, a%, any_check]),
  put (a%, units_check (a%), value_check),
  put (a%, u%, units),
  if featurep (a%, 'dimensional) = false
    then apply (declare, [a%, 'dimensional]));

declare_qty (a%, q%) :=
  block (local (a%, q%),
  if listp(a%)
    then map (lambda ([a1%], local(a1%), declare1_qty (a1%, q%)), a%)
    else declare1_qty (a%, q%), q%);

/* Maybe we want to work with constvalue in declare1_qty
 * (instead of the indicator qty).
 */
declare1_qty (a%, q%) :=
  block (local (a%, q%),
  if featurep (a%, 'dimensional) = false
    then apply (declare, [a%, 'dimensional]), put (a%, q%, qty));

units_check (zz%) :=
  block (local (zz%),
  buildq ([zz%: zz%], lambda([yy%],
    if units('zz%) # 1 and units(yy%) # 1 and units(yy%) # units('zz%)
    then throw (oops ('zz%, yy%)))));

qty(e%) :=
  block (local (e%),
  if atom(e%) then
    if featurep (e%, 'dimensional) then
      if get (e%, qty) = false then 'qty(e%) else get (e%, qty)
    else e%
  else if unitop_p(e%) then first(e%)
  else if featurep (op(e%), 'dimensional) then 'qty(e%)
  else apply (op(e%), map (qty, args(e%))));

units(e%) :=
  block (local (e%),
  if atom(e%) then 
    if featurep (e%, 'dimensional) then
      if get (e%, units) = false then 'units(e%) else get (e%, units)
    elseif symbolp (e%) and get (e%, 'constvalue) # false
      then units (get (e%, 'constvalue))
      else 1
  else if mapatom (e%) then units (op (e%))  /* mapatom but not atom => subscripted */
  else if unitop_p(e%) then second(e%)
  else if featurep (op(e%), 'dimensional) then units(op(e%))
  else if op(e%) = "^" then units (first (e%)) ^ second (e%)
  else apply (op(e%), map (units, args(e%))));

d(e%) := dimension (units (e%));

matchdeclare
  ([aa%, bb%], true,
    cc%, constantp,
    ccn0%, constantp_not0,
    ccn1%, constantp_not1,
    mm%, mult_expr_nontrivialconstfactorsp,
    nd%, nondimensional,
    pp%, lambda ([e], not atom(e) and op(e) = "+"),
    uu%, unitp,
    xx%, nonconstantp);

simp: false$
tellsimp (uu% `` nd%, apply_units_conversion (uu%, nd%));
tellsimp (pp% `` nd%, apply ("+", map (buildq ([nd%], lambda ([e], e `` nd%)), args (pp%))));
tellsimpafter (uu%^ccn1%, (qty(uu%)^ccn1%) ` simplify_units (units(uu%)^ccn1%));
tellsimpafter (nd% * uu%, multiply_with_units (nd%, uu%));
tellsimpafter (nd% + uu%, add_with_units (nd%, uu%));

/* The first ` rule here is a work-around for the behavior of the function 
 * automatically generated by tellsimpafter: in a pure simplification 
 * environment (i.e. no evaluation, e.g. expected result in test scripts)
 * the arguments are never simplified if they do not match any rule.
 * That is unlike simplification in general, in which the arguments are
 * simplified even if there is no rule for the operator and the arguments together.
 */
tellsimpafter (aa% ` bb%, ?resimplify (aa%) ` ?resimplify (bb%));

tellsimpafter (aa% ` (xx% + ccn0%), (aa% - ccn0%)`xx%);
tellsimpafter (aa% ` mm%, (constant_factors(mm%) * aa%) ` everything_else(mm%));
tellsimpafter (aa% ` cc%, aa%*cc%);
tellsimpafter (uu% ` nd%, qty (uu%) ` (units (uu%) * nd%));
tellsimpafter (abs (aa% ` bb%), abs (aa%) ` bb%);
tellsimpafter (aa% ` abs (bb%), aa% ` bb%);
simp: true$

unitop_p (e%) := not atom(e%) and atom (op(e%)) and is (nounify (op(e%)) = nounify ("`"));
unitp (e%) :=
  if atom(e%) then featurep (e%, 'dimensional)
  else if unitop_p (e%) then true
  else featurep (op(e%), 'dimensional);

constantp_not1 (x%) := constantp(x%) and x% # 1;
constantp_not0 (x%) := constantp(x%) and x% # 0;
nonconstantp (x%) := not constantp (x%);
mult_exprp (e%) := not atom(e%) and atom (op(e%)) and (nounify (op(e%)) = nounify ("*") or nounify (op(e%)) = nounify ("/"));
mult_expr_nontrivialconstfactorsp (e%) := mult_exprp (e%) and constant_factors (e%) # 1;
nondimensional (e%) := atom(e%) or (op(e%) # "`" and apply ("and", map (nondimensional, args(e%))));
nondimensional_not1 (e%) := e% # 1 and nondimensional (e%);
nondimensional_not0 (e%) := e% # 0 and nondimensional (e%);

add_with_units (x%, u%) :=
  if unitp (u%) then
    x% + u%
  else
    /* identify terms with like units and add them up. */
    block ([r%: [], a%: args(u%)],
    while a% # [] do
      block ([s%: qty(a%[1]), b%: []],
      for i%:2 thru length(a%) do
        if units (a%[i%]) = units (a%[1]) then
          s%: s% + qty (a%[i%])
        else
          b%: cons (a%[i%], b%),
      r%: cons (s%`units(a%[1]), r%),
      a%: b%),
    if length (r%) = 1 then
      x% + r%[1]
    else
      cons (x%, apply ("+", r%)));
      
multiply_with_units(x%, u%) :=
  if unitp (u%) then
    (x%*qty(u%))`units(u%)
  else
    (x%*apply ("*", map (qty, args (u%)))) ` simplify_units (apply ("*", map (units, args (u%))));

matchdeclare (a%, all);
defrule (runits1, 'units (a%), 1);

constant_factors (e%) := block ([L%, eqns%],
    e% : apply1 (e%, runits1),
    L%: listofvars(e%),
    eqns%: map ("=", L%, L%*0+1),
    subst (eqns%, e%));

everything_else(e%) := e%/constant_factors(e%);

simplify_units (e%) := block
  ([L% : listofvars (e%)],
    L% : makelist (x% > 0, x%, L%),
    apply (assume, L%),
    e% : expand (e%, 0, 0),
    apply (forget, L%),
    e%);

/* Compile matchdeclare predicate functions in hopes of greater speed */
compile (constantp_not0, constantp_not1, mult_expr_nontrivialconstfactorsp, nondimensional, unitop_p, unitp, nonconstantp);

/* A small database of elementary unit conversions */

/* Undefined and therefore treated as basic units:
 *
 * m kg s A K mol
 *
 */

conversions_derived_si :
   {
    Hz = 1/s,           /* hertz:   Frequency            */
    hertz = Hz,
    N = kg*m/s^2,       /* newton:  Force                */
    newton = N,
    Pa = N/m^2,         /* pascal:  Pressure             */
    pascal = Pa,
    J = N*m,            /* joule:   Work, energy         */
    joule = J,
    W = J/s,            /* watt:    Power                */
    watt = W,
    C = s*A,            /* coulomb: Electric charge      */
    coulomb = C,
    V = J/C,            /* volt:    Electromotive force  */
    volt = V,
    F = C^2/J,          /* farad:   Electric capacitance */
    farad = F,
    Ohm = J*s/C^2,      /* ohm:     Electric resistance  */
    ohm = Ohm,
    S = 1/Ohm,          /* siemens: Electric conductance */
    siemens = S,
    Wb = J/A,           /* weber:   Magnetic flux        */
    weber = Wb,
    T = J/m^2/A,        /* tesla:   Magnetic flux density*/
    tesla = T,
    H = J/A^2,          /* henry:   Inductance           */
    henry = H,

    mm = m/1000,
    km = 1000*m,
    Mm = 1000000*m,
    Gm = 1000000000*m,

    mg = kg/1000000,
    g = kg/1000,
    Mg = 1000*kg,
    Gg = 1000000*kg,

    ms = s/1000,
    ks = 1000*s,
    Ms = 1000000*s,
    Gs = 1000000000*s,

    mA = A/1000,
    kA = 1000*A,
    MA = 1000000*A,
    GA = 1000000000*A,

    mK = K/1000,
    kK = 1000*K,
    MK = 1000000*K,
    GK = 1000000000*K,

    mmol = mol/1000,
    kmol = 1000*mol,
    Gmol = 1000000*mol,
    Mmol = 1000000000*mol,

    mHz = Hz/1000,
    kHz = 1000*Hz,
    MHz = 1000000*Hz,
    GHz = 1000000000*Hz,

    mN = N/1000,
    kN = 1000*N,
    MN = 1000000*N,
    GN = 1000000000*N,

    mPa = Pa/1000,
    kPa = 1000*Pa,
    MPa = 1000000*Pa,
    GPa = 1000000000*Pa,

    mJ = J/1000,
    kJ = 1000*J,
    MJ = 1000000*J,
    GJ = 1000000000*J,

    mW = W/1000,
    kW = 1000*W,
    MW = 1000000*W,
    GW = 1000000000*W,

    mC = C/1000,
    kC = 1000*C,
    MC = 1000000*C,
    GC = 1000000000*C,

    mV = V/1000,
    kV = 1000*V,
    MV = 1000000*V,
    GV = 1000000000*V,

    mF = F/1000,
    kF = 1000*F,
    MF = 1000000*F,
    GF = 1000000000*F,

    mOhm = Ohm/1000,
    kOhm = 1000*Ohm,
    MOhm = 1000000*Ohm,
    GOhm = 1000000000*Ohm,

    mS = S/1000,
    kS = 1000*S,
    MS = 1000000*S,
    GS = 1000000000*S,

    mWb = Wb/1000,
    kWb = 1000*Wb,
    MWb = 1000000*Wb,
    GWb = 1000000000*Wb,

    mT = T/1000,
    kT = 1000*T,
    MT = 1000000*T,
    GT = 1000000000*T,

    mH = H/1000,
    kH = 1000*H,
    MH = 1000000*H,
    GH = 1000000000*H,

    micrometer = m/1000000,
    micron = micrometer,
    cm = m/100,
    meter = m,
    kilometer = km,

    /* International Astronomical Union best estimate (2009) according to Wikipedia */
    astronomical_unit = 149597870700 * m,
    AU = astronomical_unit,

    julian_year = (365 + 1/4) * 86400 * s,
    light_year = julian_year * 299792458 * m / s,

    parsec = 360 * 60 * 60 / (2 * %pi) * astronomical_unit,
    pc = parsec,

    microgram = kg/1000000000,
    metric_ton = Mg,
    kilogram = kg,
    gram = g,

    ns = s/1000000000,
    microsecond = s/1000000,
    
    hectare = 100*m^2,
    ha = hectare,

    liter = m^3/1000,
    l = liter,
    ml = l / 1000,

    candela = cd,
    lumen = cd,
    lux = lumen/m^2,

    becquerel = 1/s,
    Bq = becquerel,

    gray = J/kg,
    Gy = gray,
    sievert = gray,
    Sv = sievert,

    katal = mol/s,
    kat = katal

   };

texput (mOhm, "{\\mathrm m\\Omega}");
texput (Ohm, "{\\mathrm \\Omega}");
texput (kOhm, "{\\mathrm k\\Omega}");
texput (MOhm, "{\\mathrm M\\Omega}");
texput (GOhm, "{\\mathrm G\\Omega}");

texput (micrometer, "\\mu {\\mathrm m}");
texput (micron, "\\mu {\\mathrm m}");
texput (microgram, "\\mu {\\mathrm g}");
texput (microsecond, "\\mu {\\mathrm s}");

texput (metric_ton, "{\\mathrm metric\\ ton}");

conversions_customary_si :
   {

    feet = 3048/10000 * m,
    /* International pound avoirdupois */
    pound_mass = 45359237/10^8 * kg,
    minute = 60*s,
    hour = 3600*s,
    day = 86400*s,
    week = 7*86400*s,
    month = (30 + 7/16)*86400*s,
    year = (365 + 1/4)*86400*s,
    Btu = 1055*J,
    R = 5/9*K

   };
   
conversions_customary_customary :
   {

    inch = feet/12,
    yard = 3*feet,
    mile = 5280*feet,
    gallon = 231*inch^3,
    slug = pound_force*s^2/foot,
    ounce = pound_mass/16,
    /* grain = ???, */
    /* assume gravitational acceleration = 980.665 cm/s^2 */
    pound_force = pound_mass*196133/6096*ft/s^2,
    acre = 55*88*yard^2,
    psi = pound_force/inch^2,
    cfm = feet^3/minute,

    ft = feet,
    foot = feet,
    lbm = pound_mass,
    oz = ounce,
    lbf = pound_force,
    horsepower = 550 * pound_force * foot / s,
    hp = horsepower,

    short_ton = 2000*lbm,
    rod = 33/2*feet,

    quart = gallon / 4,
    pint = quart / 2,
    cup = pint / 2,
    gill = cup / 2,
    fluid_ounce = cup / 8,
    fl_oz = fluid_ounce,
    tablespoon = fluid_ounce / 2,
    teaspoon = tablespoon / 3,
    tbsp = tablespoon,
    tsp = teaspoon

   };

known_unit_conversions :
    union
       (conversions_derived_si,
        conversions_customary_si,
        conversions_customary_customary);

declare_unit_conversion ([L]) :=
   (if not every (equationp, L)
        then error ("declare_unit_conversion: all arguments must be equations."),
    setify (ratsimp (L)),
    map (flatten_conversion_equation, %%),
    known_unit_conversions : union (known_unit_conversions, %%),
    kill (conversions_to_base_units),
    done);

flatten_conversion_equation (e%) := block
  ([l% : lhs (e%), r% : rhs (e%)],
    if unitop_p (l%) and unitop_p (r%)
        then qty (l%) * units (l%) = qty (r%) * units (r%)
        else e%);

equationp (e) := not atom (e) and op (e) = "=";

compute_conversion_factor (u1%, u2%) :=
 (if conversions_to_base_units = 'conversions_to_base_units
    then compute_conversions_to_base_units (),
  ev (simplify_units (u1% / u2%), conversions_to_base_units));

compute_conversions_to_base_units () :=
 (print ("ezunits: computing conversions to base units; may take a moment."),
  conversions_to_base_units : listify (compute_conversions_to_base_units0 (known_unit_conversions)));

compute_conversions_to_base_units0 (conversion_eqns) :=
block ([derived_units, primitive_units, defined_so_far, undefined_so_far, definitions, definablep, now_definable],

  derived_units : map (lhs, conversion_eqns),
  primitive_units : setdifference (setify (listofvars (map (rhs, conversion_eqns))), derived_units),
  defined_so_far : primitive_units,
  undefined_so_far : conversion_eqns,
  definitions : {},

  definablep : lambda ([e], every (lambda ([x], elementp (x, defined_so_far)), setify (listofvars (rhs (e))))),
  now_definable : subset (undefined_so_far, definablep),

  while length (now_definable) > 0
    do block ([make_definition, new_definitions],
      make_definition : lambda ([e], block ([L : listofvars (rhs (e))],
                       for x in definitions do if member (lhs (x), L) then e : subst (x, e)), e),
        
      new_definitions : map (make_definition, now_definable),
      definitions : union (definitions, new_definitions),
      defined_so_far : union (defined_so_far, map (lhs, new_definitions)),
      undefined_so_far : setdifference (undefined_so_far, now_definable),
      now_definable : subset (undefined_so_far, definablep)),
  
  if undefined_so_far # {} then print ("ezunits: hmm, these are still undefined:", map (lhs, undefined_so_far)),
  definitions);

apply_units_conversion (uu%, nd%) :=
  if listp (nd%)
    /* Handle conversions of the form foo `` [u1, u2, u3].
     * May want to ensure dimensions of u1, u2, u3 are all the same.
     * Might change list to some other operator, e.g. noncommutative plus
     * (which would have to be invented for the purpose).
     */
    then block ([q%, r%],
        q% : convert_units [units (uu%), first (nd%)] (qty (uu%)),
        r% : [(if rest (nd%) = [] then q% else floor (q%)) ` first (nd%)],
        while rest (nd%) # []
            do
               (q% : convert_units [first (nd%), second (nd%)] (q% - floor (q%)),
                nd% : rest (nd%),
                r% : cons ((if rest (nd%) = [] then q% else floor (q%)) ` first (nd%), r%)),
        reverse (r%))

    else convert_units [units(uu%), nd%] (qty(uu%)) ` nd%;
    
convert_units [u1%, u2%] := block ([a%],
  a% : compute_conversion_factor (u1%, u2%),
  if constantp (a%)
    then buildq ([a%], lambda ([x], a% * x))
    else buildq ([u1%], lambda ([x], x ` u1%)));

convert_units [degF, degC] : lambda ([x], 5/9*(x - 32));
convert_units [degC, degF] : lambda ([x], 32 + 9/5*x);
convert_units [degC, K] : lambda ([x], 27315/100 + x);
convert_units [degF, R] : lambda ([x], 45967/100 + x);
convert_units [K, degC] : lambda ([x], x - 27315/100);
convert_units [R, degF] : lambda ([x], x - 45967/100);

/* Dimensional analysis
 */

declare_dimensions ([L%]) :=
    if length (L%) > 2
        then (declare_dimensions1 (L%[1], L%[2]), apply (declare_dimensions, rest (rest (L%))))
        elseif length (L%) = 2
            then (declare_dimensions1 (L%[1], L%[2]), 'done)
            else error ("declare_dimensions: expected an even number of arguments.");
    
declare_dimensions1 (a%, b%) :=
    if listp (a%)
        then map (lambda ([a1%], declare_dimensions1 (a1%, b%)), a%)
        elseif symbolp (b%)
            then put (a%, b%, 'dimension)
            else error ("declare_dimensions: second argument must be a symbol.");

remove_dimensions ([L%]) :=
   (if not every (symbolp, L)
        then error ("remove_dimensions: all arguments must be symbols."),
    map (lambda ([a%], put (a%, false, 'dimension)), L%));

declare_fundamental_dimensions ([L]) :=
   (if not every (symbolp, L)
        then error ("declare_fundamental_dimensions: all arguments must be symbols."),
    L : sublist (L, lambda ([a], not member (a, fundamental_dimensions))),
    map (lambda ([a], assume (a > 0)), L),
    fundamental_dimensions : append (fundamental_dimensions, L),
    'done);

remove_fundamental_dimensions ([L]) :=
    if L = '[all]
        then apply (remove_fundamental_dimensions, fundamental_dimensions)
        else
           (fundamental_dimensions : sublist (fundamental_dimensions, lambda ([x], not member (x, L))),
            map (lambda ([a], forget (a > 0)), L),
            'done);

declare_fundamental_units ([L]) :=
   (if not every (symbolp, L)
        then error ("declare_fundamental_units: all arguments must be symbols."),
    map (lambda ([x, y], put (x, y, 'dimension)), odds (L), evens (L)),
    map (lambda ([x, y], put (y, x, 'unit)), odds (L), evens (L)));

remove_fundamental_units ([L]) :=
   (if not every (symbolp, L)
        then error ("remove_fundamental_units: all arguments must be symbols."),
    map (lambda ([x], put (get (x, 'dimension), false, 'unit)), L),
    map (lambda ([x], put (x, false, 'dimension)), L));

fundamental_dimensions : [];
L : [[m, length], [kg, mass], [s, time], [A, current], [K, temperature], [mol, quantity], [cd, luminous_intensity]];
apply (declare_fundamental_dimensions, map (second, L));
apply (declare_fundamental_units, flatten (L));

/* I GUESS RULES FOR DIMENSIONS COULD RECOGNIZE EQUATIONS, DERIVATIVES, AND INTEGRALS
 */

matchdeclare
   (aa%, lambda ([e%], atom (e%) and not symbolp (e%)),
    bb%, lambda ([e%], symbolp (e%) and member (e%, fundamental_dimensions)),
    cc%, lambda ([e%], symbolp (e%) and get (e%, 'units) # false),
    dd%, lambda ([e%], symbolp (e%) and get (e%, 'constvalue) # false),
    ee%, lambda ([e%], symbolp (e%) and get (e%, 'dimension) # false),
    ee1%, lambda ([e%], symbolp (e%) and ?mget (e%, 'numer) # false),
    ff%, lambda ([e%], symbolp (e%)),
    gg%, lambda ([e%], not atom (e%) and op (e%) = "`"),
    hh%, lambda ([e%], not atom (e%) and op (e%) = "^"),
    ii%, lambda ([e%], not atom (e%) and member (op (e%), ["+", "-", "*", "/"])));

simp : false;
defrule (raa, 'dimensions (aa%), 1);
defrule (rbb, 'dimensions (bb%), bb%);
defrule (rcc, 'dimensions (cc%), dimensions (get (cc%, 'units)));
defrule (rdd, 'dimensions (dd%), dimensions (get (dd%, 'constvalue)));
defrule (ree, 'dimensions (ee%), get (ee%, 'dimension));
defrule (ree1, 'dimensions (ee1%), dimensions (?mget (ee1%, 'numer)));
defrule
   (rff,
    'dimensions (ff%), 
    block
      ([ff%2 : ev (ff%, args (known_unit_conversions), infeval)],
        if ff%2 # ff% then dimensions (ff%2) else 'dimensions (ff%)));
defrule (rgg, 'dimensions (gg%), (constvalue (first (gg%)), if unitp (%%) then dimensions (second (%%)) else 1) * dimensions (second (gg%)));
matchdeclare (aa%, all, bb%, constantp_not1);
defrule (rhh, 'dimensions (aa%^bb%), dimensions (aa%) ^ bb%);
defrule (rii, 'dimensions (ii%), map (dimensions, ii%));
/* ??? defrule (rjj, 'dimensions (sqrt (aa%)), sqrt (dimensions (aa%))); */
simp : true;

dimensions (expr) :=
    apply (apply1, ['dimensions (expr), raa, rbb, rcc, rdd, ree, ree1, rff, rgg, rhh, rii]);

/* Adapted from dimensions_as_list in share/physics/dimension.mac.
 * Thanks to Barton Willis.
 */
/* FOLLOWING DEFINITION HANDLES DIMENSION NOUNS INCORRECTLY
 * NEED TO REVISIT THIS
 */
dimensions_as_list (e) :=
    if listp (e)
        then map ('dimensions_as_list, e)
        else
           (e : dimensions (e),
            if polynomialp (e, fundamental_dimensions, lambda ([x], numberp (x)), lambda ([x], integerp (x)))
                then makelist (hipow (e, d), d, fundamental_dimensions)
                else 'dimensions_as_list (e));

fundamental_units ([L]) :=
    if L = []
        then
            map
               (lambda ([x], (get (x, 'unit), if %% = false then 'unit (x) else %%)),
                fundamental_dimensions)
        else
            if listp (L [1])
                then map ('fundamental_units, L [1])
                else block ([d],
                    d : dimensions_as_list (L [1]),
                    if listp (d)
                        then apply ("*", map ("^", fundamental_units (), d))
                        else 'fundamental_units (L [1]));

/* Adapted from dimensionless in share/physics/dimension.mac.
 * Thanks to Barton Willis.
 */

dimensionless (e) :=
    if not listp (e)
        then 'dimensionless (e)
        else
            args
               (map
                   (lambda ([s], xreduce ("*", map("^", e, first (transpose (s))))),
                    nullspace (transpose (funmake ('matrix, map ('dimensions_as_list, e))))));

/* Adapted from natural_unit in share/physics/dimension.mac.
 * Thanks to Barton Willis.
 */

natural_unit (d, e) :=
block
  ([vars, s],
 
    if not listp (e)
        then return ('natural_unit (d, e)),

    d : dimensions_as_list (d),
    s : map ('dimensions_as_list, e),
    vars : makelist (?gensym(), k, 1, length (e)),

    block
      ([linsolve_params : true,
        back_subst : true,
        globalsolve : false],
        s : linsolve (s . vars - d, vars)),

    s : xreduce ("*", map ("^", e, map ('rhs, s))),
    s : subst (map ("=", %rnum_list, makelist (0, i, 1, length (%rnum_list))), s),
    map (lambda ([x], s * x), cons (1, dimensionless (e))));

/* A couple of convenience functions.
 */

derived_units () :=
    listify (map (lhs, conversions_to_base_units));

known_units () :=
    sort (append (fundamental_units (), derived_units ()));

display_known_unit_conversions () := 
    for x in known_unit_conversions do display (x);

/* Rules to unit-ify 'diff and 'integrate expressions.
 */

simp : false;

matchdeclare ([uu%, vv%, aa%, bb%], unitp);

tellsimp ('diff (uu%, vv%, 1), 'diff (qty (uu%), qty (vv%), 1) ` (units (uu%) / units (vv%)));

tellsimp ('integrate (uu%, vv%), 'integrate (qty (uu%), qty (vv%)) ` (units (uu%) * units (vv%)));

tellsimp
   ('integrate (uu%, vv%, aa%, bb%),
    if units (aa%) = units (vv%) and units (bb%) = units (vv%)
        then 'integrate (qty (uu%), qty (vv%), qty (aa%), qty (bb%)) ` (units (uu%) * units (vv%))
        else 'integrate (qty (uu%), qty (vv%), qty (aa% `` units (vv%)), qty (bb% `` units (vv%))) ` (units (uu%) * units (vv%)));

simp : true;
