How to transform a noncommutative product to a different expression?

Question

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.

Answer 1

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"}*)

Answer 2

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

Answer 3

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