Message Boards Message Boards

GROUPS:

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

4 Replies

David,

To replace “*” with newTimes do

polyExpression /. Times -> newTimes

Now there will no longer be any regular multiplication in the expression.

Regards

Neil

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

Posted 8 days ago

Thank you, I will take a look.

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]*)
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract