Message Boards Message Boards

0
|
3844 Views
|
4 Replies
|
4 Total Likes
View groups...
Share
Share this post:

Custom multiplication operation between variables

Posted 3 years ago

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

POSTED BY: David L
4 Replies

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 BY: Neil Singer
Posted 3 years ago

Thank you, I will take a look.

POSTED BY: David L
Posted 3 years 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]*)
POSTED BY: Updating Name

David,

To replace “*” with newTimes do

polyExpression /. Times -> newTimes

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

Regards

Neil

POSTED BY: Neil Singer
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