Assembling a set of expressions?

Posted 3 months ago
346 Views
|
|
0 Total Likes
|
 I am trying to assemble a set of expressions using a "universal algorithm" The input would be of the form list = CharacterRange["a","e"] The range given above corresponds to the example given, the algorithm would need to adapt to any range but it would always start at "a".From the list or input the following expressions are required {a1 = {a^2 b c d e, b^2 c d e, c^2 d e, d^2 e, e^2}, a2 = { a^2, a b^2 c d e, a c^2 d e, a d^2 e, a e^2}, a3 = { a^2 b, b^2, a b c^2 d e, a b d^2 e, a b e^2}, a4 = {a^2 b c, b^2 c, c^2, a b c d^2 e, a b c e^2}, a5 = {a^2 b c d, b^2 c d, c^2 d, d^2, a b c d e^2}} The next few steps are to perhaps make it easier to see any pattern cr = {a2, RotateRight[a3, 4], RotateRight[a4, 3], RotateRight[a5, 2], RotateRight[a1]};Grid[cr, Frame -> All, Alignment -> Left] So 5 characters produces 5 expressions each 5 terms in length and each expression has a sub-term of length 1 to 5, each sub-term has at most 1 square character and if we look at the square character in each length sub-term the normal characters start alphabetically after the square character and loop back round if required.As a check here are the required expressions for the character length 2, 3 and 4 {{a^2 b,b^2}, {a^2,a b^2}} {{a^2 b c,b^2 c,c^2}, {a^2,a b^2 c,a c^2}, {a^2 b,b^2,a b c^2}} {{a^2 b c d,b^2 c d,c^2 d,d^2}, {a^2,a b^2 c d,a c^2 d,a d^2}, {a^2 b,b^2,a b c^2 d,a b d^2}, {a^2 b c,b^2 c,c^2,a b c d^2}} Each of these expressions are the result of Reducing a set of equations, I have stripped out the coefficients of the terms for brevity. My problem is Mathematica is giving one complete expression and all the others are then assembled from this expression, like so;- u == (-a^2 b c d - 12 b^2 c d - 144 c^2 d - 1728 d^2)/(-41472 + 2 a b c d) and v == 1/24 (a^2 + 2 a u) && w == 1/24 (b^2 + 2 b v) && x == 1/24 (c^2 + 2 c w) and not only that, with 5 terms its taking just over 10 minutes to compute and I really need to extend the solutions to at least 10 terms, so I'm looking for ideas or pointers to ease in the construction of the terms if possible, thank you.
 AmendmentI have managed to solve my problem with the following code. I am however always open to suggestions or tips on how to streamline things lst = CharacterRange["a", "e"]; lenl = Length[lst]; bl = Join[lst, lst]; tbl = Flatten[Table[ Table[bl[[q1 ;; q2]], {q2, lenl + i, lenl + i}, {q1, 1 + i, lenl + i}], {i, 0, lenl - 1}], 1]; jt = Join @@ tbl; Do[ jt[[i]][[1]] = jt[[i]][[1]]^2, {i, 1, Length[jt]}]; jt1 = Times @@@ jt; jt2 = Partition[jt1, lenl]; Grid[jt2, Frame -> All, Alignment -> Left]