# Custom multiplication operation between variables

Posted 8 days ago
160 Views
|
4 Replies
|
4 Total Likes
|
 I am constructing polynomial expressions in the variables s[0],...,s[n] with (coefficients that are other variables) and I'm trying to define a new operation to simplify the expression: $Assumptions = B \[Element] Complexes vars = Table[s[j], {j, 0, 20}]; newTimes[] := 1 newTimes[a_] := a newTimes[s[0], b_] := b newTimes[a_, s[0]] := a newTimes[a___, newTimes[b_, c__], d___] := newTimes[a, b, c, d]; newTimes[a___, s[i_Integer]*s[j_Integer], d___] := newTimes[a, newTimes[s[i], s[j]], d]; newTimes[a___, x_ + y_, b___] := newTimes[a, x, b] + newTimes[a, y, b]; newTimes[a___, (K_ /; (! MemberQ[vars, K]))*s[i_Integer], b___] := K*ncTimes[a, s[i], b]; newTimes[a___, (K_ /; (! MemberQ[vars, K])), b___] := K*ncTimes[a, b]; (*B a complex valued variable*) newTimes[a___, s[i_Integer], s[i_Integer], b___] := B*newTimes[a, s[i], b]; newTimes[a___, K_Complex*s[i_Integer], b___] := K*newTimes[a, s[i], b]; newTimes[a___, s[i_Integer], s[i_Integer + 1], s[i_Integer], b___] := newTimes[a, s[i], b]; newTimes[a___, s[i_Integer], s[i_Integer - 1], s[i_Integer], b___] := newTimes[a, s[i], b]; newTimes[a___, s[i_Integer], s[j_Integer], b___] /; TrueQ[Abs[i - j] > 1] := newTimes[a, s[j]*s[i], b]; newTimes[a___, s[i_Integer], s[j_Integer], b___] /; TrueQ[Abs[i - j] < 2] := newTimes[a, s[i]*s[j], b]; How can I apply this to an already built polynomial? For example s[1]+5s[4]s[0]s[2]-s[4]s[2] and then I want to apply newTimes anywhere their is a multiplication of the variables. How do I make sure Mathematica uses my multiplication on s[i] variables and does not simplify (e.g. Commuting s[i] ) using the normal rules for *? So far it seems to build expressions with squares and not simplify them fully Answer 4 Replies Sort By: Posted 8 days ago  David,To replace “*” with newTimes do polyExpression /. Times -> newTimes Now there will no longer be any regular multiplication in the expression.Regards Neil Answer Posted 8 days ago  Also, you should look at using built in attributes for your function such as Listable, Orderless, etc. Also, look at the documentation for NonCommutativeMultiply -- it shows how to simplify some of the rules you are making.Regards,Neil Answer Posted 8 days ago  Thank you, I will take a look. Answer Posted 8 days ago  I tried to make changes based on the documentation for NonCommutativeMultiply but I'm not getting the results I expect: $Assumptions = B \[Element] Complexes; vars = Table[s[j], {j, 0, 20}]; Clear[nT]; ClearAttributes[nT, Attributes@nT] SetAttributes[nT, {Flat, Listable, OneIdentity}]; nT[a_ + b_, c_] := nT[a, c] + nT[b, c] nT[a_, b_ + c_] := nT[a, b] + nT[a, c] nT[a_] := a nT[s[0], b_] := b nT[a_, s[0]] := a nT[(K_ /; (! MemberQ[vars, K]))*s[i_Integer], b___] := K*nT[s[i], b] nT[a___, (K_ /; (! MemberQ[vars, K]))*s[i_Integer]] := K*nT[a, s[i]] nT[a__ ** b_, c_] := nT[a, b, c] nT[a_^n_Integer, expr_] /; n > 1 := Nest[Expand[nT[a, #1]] &, expr, n] nT[(K_ /; (! MemberQ[vars, K])), b_] := K*b nT[s[i_Integer], s[i_]] /; i != 0 := B*s[i] nT[a___, s[i_Integer], s[i_ + 1], s[i_], b___] := nT[a, s[i], b]; nT[a___, s[i_Integer], s[i_ - 1], s[i_], b___] := nT[a, s[i], b]; nT[a___, s[i_Integer], s[j_Integer], b___] /; TrueQ[Abs[i - j] > 1] := nT[a, s[j]*s[i], b]; nT[a___, s[i_Integer], s[j_Integer], b___] /; TrueQ[Abs[i - j] < 2] := nT[a, s[i]*s[j], b]; ExpandNCM[(h : NonCommutativeMultiply)[a___, b_Plus, c___]] := Distribute[h[a, b, c], Plus, h, Plus, ExpandNCM[h[##]] &] ExpandNCM[(h : NonCommutativeMultiply)[a___, b_Times, c___]] := Most[b] ExpandNCM[h[a, Last[b], c]] ExpandNCM[a_] := ExpandAll[a] Unprotect[NonCommutativeMultiply]; NonCommutativeMultiply[a___] := nT[a] For example: p2 = s[0] + s[1] + s[3] ExpandNCM[s[0] ** p2] (*s[0]^2 + s[0] s[1] + s[0] s[3]*)