0
$\begingroup$

I have a (long) sum of the following ** (noncommutative) products:

gg**qs**rh  

(each variable always consists of two letters like in the artificial example above and the 'length' of the product varies) and I would like to tranform it into the following ordinary multiplication:

ipgq ipsr ipgh

where ipxy is a variable created by merging 'ip' with the symbols surrounding each ** (in this case gq and sr) and the last one created from the outermost two symbols (gh). The order of xy's matters but the product order of ipxy's does not since it is the usual multiplication.

$\endgroup$
  • $\begingroup$ Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Take the tour! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$ – Michael E2 Dec 13 '15 at 13:26
  • $\begingroup$ It would be useful to have a specific example, in Mathematica form. $\endgroup$ – Daniel Lichtblau Dec 13 '15 at 21:33
1
$\begingroup$

Update

pro2Sum[pro_] := Module[{str, part, f},
str = Table[
DeleteCases[DeleteCases[Characters[ToString[pro[[i]]]], " "], 
 "*"], {i, 1, Length[pro]}];
 part = Table[
Partition[
 Join[Drop[Drop[str[[i]], -1], 1], Take[str[[i]], 1], 
  Take[str[[i]], -1]], 2], {i, 1, Length[str]}];
f[a_, b_] := "ip" <> ToString[a] <> ToString[b];
Total[Times @@@ Table[f @@@ part[[i]], {i, 1, Length[part]}]]
 ]

npr = gg ** qs ** rh + ab ** cd ** ef;
pro2Sum[npr]
(*"ipaf" "ipbc" "ipde" + "ipgh" "ipgq" "ipsr"*)

Define your product

npr = gg ** qs ** rh

Convert to string and remove blank space and the asterisks

str = DeleteCases[DeleteCases[Characters[ToString[npr]]," "], "*"]

(*{"g", "g", "q", "s", "r", "h"}*)

Partition the list

 part = Partition[
 Join[Drop[Drop[str, -1], 1], Take[str, 1], Take[str, -1]], 2]

 (*{{"g", "q"}, {"s", "r"}, {"g", "h"}}*)

Make a formatting function

  f[a_, b_] := "ip" <> ToString[a] <> ToString[b]

Use it to format the partitioned list

  f @@@ part

  (*{"ipgq", "ipsr", "ipgh"}*)
$\endgroup$
  • $\begingroup$ This is very cool but how do I apply it 'linearly' ? As I wrote, I have a long sum of these products and I want to end up with a sum of 'ip' products. I cannot take summands one by one, apply your map and assemble it back. $\endgroup$ – merchant Dec 13 '15 at 14:47
  • $\begingroup$ check the updated answer $\endgroup$ – Hubble07 Dec 13 '15 at 15:20
  • $\begingroup$ I really appreciate your help. I may be expressing myself in a lousy way but the output of pro2Sum[npr] should be ipgq ipsr ipgh+ipaf ipbc ipde. Or just {"ipgq", "ipsr", "ipgh"} and {"ipaf ", "ipbc ", "ipde"} so that I know from what summand the new ip expressions come from. $\endgroup$ – merchant Dec 13 '15 at 15:37
  • $\begingroup$ check update. Just remove the Total and Times to get in the list format. $\endgroup$ – Hubble07 Dec 13 '15 at 16:11
1
$\begingroup$
pro = ab ** cd;

cha = Characters @ StringReplace[ToString @ pro, "*" | " " -> ""];

par = Partition[cha[[2 ;; -2]]~Join~cha[[{1, -1}]], 2]

{{"b", "c"}, {"a", "d"}}

Times @@ ToExpression[StringJoin /@ Prepend["ip"] /@ par]

ipad ipbc

$\endgroup$
0
$\begingroup$

I usually try to avoid naming variables in this way when individual characters of the name are going to be operated and instead name them in such a way that those elements can be accessed easily without string conversion (say using something like Subscript[a,2] instead of a2 or the like).

In your case, if changing your convention isn't difficult to your remaining code, I'd recommend something like

a**g.q**s.r**h

This way, you have two distinct forms of noncommutative multiplication. I swapped the NonCommutativeMultiplication with Dot from what you were using rather than simply adding Dot between the letters because doing that was structurally different from your desired representation due to the operator precedence relationship between NonCommutativeMultiply and Dot.

Then, we can use functions that access elements of your variables easily and define

Clear[f]
f[a_Plus] := Map[f, a]
f[a_Dot] := 
 Dot @@ Map[i**p**# &]@
   MapAt[Reverse, 
    ListConvolve[{1, 2}, List @@ a, {-1, -1}, a[[1]], #2[[#1]] &, 
     NonCommutativeMultiply], -1]
f[a**g.q**s.r**h + g**g.q**s.r**h]
i**p**g**q.i**p**s**r.i**p**a**h + i**p**g**q.i**p**s**r.i**p**g**h
$\endgroup$
  • $\begingroup$ This is nice but @Hubble07's answer is more suitable for my purposes. In reality, the two-letter expressions are rank-one operators (like |ket><bra| in QM), ** is non-com multiplication and what I need to find is simply the trace of a long sum of these products. I rephrased it as a symbolic sequence manipulation task since none of the QM extensions of Mathematica I found suits my purposes. $\endgroup$ – merchant Dec 13 '15 at 16:42
  • $\begingroup$ Sparse matrices would be much more suitable to that purpose. $\endgroup$ – IPoiler Dec 13 '15 at 16:50

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.