Re: efficient term collection algorithm
- To: mathgroup at smc.vnet.net
- Subject: [mg69183] Re: [mg69155] efficient term collection algorithm
- From: János <janos.lobb at yale.edu>
- Date: Fri, 1 Sep 2006 06:41:09 -0400 (EDT)
- References: <200608310839.EAA19589@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
On Aug 31, 2006, at 4:39 AM, Blake Laing wrote:
> Dear Math Group
>
> I wish to combine terms in a expression which share a denominator,
> such
> as in the following simple case:
>
> In[1]:=
> a/i+b/j+c/i//.Plus[Times[A_.,Power[denom_,-1]],Times[B_.,Power
> [denom_,-1]]]:>
> Factor[Plus[A,B]Power[denom,-1]]//InputForm
> Out[1]//InputForm=
> (a + c)/i + b/j
>
> The actual expression I am working with contains thousands of
> terms, and
> a pairwise algorithm such as this is wholly inadequate. Will one of
> you
> please suggest a more efficient way to combine each additive term in a
> large expression with a shared denominator?
>
> Thanks,
>
> Blake Laing
> physics grad student
> University of Oklahoma
>
My newbie approach to it would be:
First create an alphabet and a random expression of rationales for
illustration:
In[1]:=
abc = {a, b, c, d, e, f, g,
h, i, j, k, l, m, n, o,
p, q, r, s, t, u, v, w,
x, y, z};
In[2]:=
eex = Total[Table[
abc[[Random[Integer,
{1, Length[abc]}]]]/
abc[[Random[Integer,
{1, Length[abc]}]]],
{ii, 1, 100}]]
Out[2]=
2 + b/c + (2*f)/e + b/g +
c/g + g/b + g/f + c/h +
h/c + a/i + e/i + i/a +
i/f + (2*h)/j + j/i + e/k +
k/j + (2*e)/l + (2*l)/b +
a/n + e/n + n/h + m/o +
o/e + o/j + o/n + g/p +
p/i + p/j + p/k + b/q +
k/q + q/b + q/g + q/i +
c/r + f/r + i/r + r/k +
r/l + s/b + (2*s)/d + s/f +
a/t + d/t + j/t + n/t +
r/t + t/c + (2*t)/j + t/o +
c/u + g/u + k/u + n/u +
u/d + u/h + u/k + u/q +
o/v + v/b + v/e + v/j +
v/q + h/w + l/w + w/d +
w/s + w/t + k/x + n/x +
t/x + x/b + x/d + x/e +
x/v + e/y + j/y + m/y +
o/y + (2*y)/c + y/h + y/k +
y/v + b/z + c/z + t/z +
z/a + z/l + z/t + z/v + z/w
Lets drop the integer and break the expression into a List:
In[3]:=
lsteex = DeleteCases[
Table[eex[[ii]],
{ii, 1, Length[eex]}],
_Integer]
Out[3]=
{b/c, (2*f)/e, b/g, c/g, g/b,
g/f, c/h, h/c, a/i, e/i,
i/a, i/f, (2*h)/j, j/i,
e/k, k/j, (2*e)/l, (2*l)/b,
a/n, e/n, n/h, m/o, o/e,
o/j, o/n, g/p, p/i, p/j,
p/k, b/q, k/q, q/b, q/g,
q/i, c/r, f/r, i/r, r/k,
r/l, s/b, (2*s)/d, s/f,
a/t, d/t, j/t, n/t, r/t,
t/c, (2*t)/j, t/o, c/u,
g/u, k/u, n/u, u/d, u/h,
u/k, u/q, o/v, v/b, v/e,
v/j, v/q, h/w, l/w, w/d,
w/s, w/t, k/x, n/x, t/x,
x/b, x/d, x/e, x/v, e/y,
j/y, m/y, o/y, (2*y)/c,
y/h, y/k, y/v, b/z, c/z,
t/z, z/a, z/l, z/t, z/v,
z/w}
Lets Sort it based upon where the denominator Position is in the
alphabet and after the Sort Split it based upon the equivalence of
the Denominators:
In[4]:=
sseex = Split[Sort[lsteex,
Position[abc, Denominator[
#1]][[1,1]] <
Position[abc,
Denominator[#2]][[1,
1]] & ],
Denominator[#1] ===
Denominator[#2] & ]
Out[4]=
{{z/a, i/a}, {x/b, v/b, s/b,
q/b, (2*l)/b, g/b},
{(2*y)/c, t/c, h/c, b/c},
{x/d, w/d, u/d, (2*s)/d},
{x/e, v/e, o/e, (2*f)/e},
{s/f, i/f, g/f},
{q/g, c/g, b/g},
{y/h, u/h, n/h, c/h},
{q/i, p/i, j/i, e/i, a/i},
{v/j, (2*t)/j, p/j, o/j,
k/j, (2*h)/j}, {y/k, u/k,
r/k, p/k, e/k},
{z/l, r/l, (2*e)/l},
{o/n, e/n, a/n},
{t/o, m/o}, {g/p},
{v/q, u/q, k/q, b/q},
{i/r, f/r, c/r}, {w/s},
{z/t, w/t, r/t, n/t, j/t,
d/t, a/t}, {n/u, k/u, g/u,
c/u}, {z/v, y/v, x/v,
o/v}, {z/w, l/w, h/w},
{t/x, n/x, k/x},
{o/y, m/y, j/y, e/y},
{t/z, c/z, b/z}}
From here on lets Total and Factor all the sublists and Total again
the results:
In[27]:=
Total[(Factor[Total[
#1]] & ) /@ sseex]
Out[27]=
(a + e + o)/n + g/p +
(b + c + q)/g +
(a + e + j + p + q)/i +
(c + f + i)/r + (g + i + s)/
f + (m + t)/o +
(c + g + k + n)/u +
(2*h + k + o + p + 2*t + v)/
j + (b + k + u + v)/q +
w/s + (k + n + t)/x +
(2*f + o + v + x)/e +
(g + 2*l + q + s + v + x)/
b + (2*s + u + w + x)/d +
(e + j + m + o)/y +
(c + n + u + y)/h +
(e + p + r + u + y)/k +
(b + h + t + 2*y)/c +
(b + c + t)/z + (i + z)/a +
(h + l + z)/w +
(2*e + r + z)/l +
(a + d + j + n + r + w + z)/
t + (o + x + y + z)/v
Now, your abc probably should be a Union-ed list of all denominators.
With the best,
János