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