# 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,...,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, b_] := b newTimes[a_, s] := 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+5sss-ss 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, b_] := b nT[a_, s] := 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 + s + s ExpandNCM[s ** p2] (*s^2 + s s + s s*) Answer