Suppose I have two lists of the equal length in the form

powers= {{rho th},{mu},{beta},{nu},{r},{}}

subscripts={{ }, {a}, {th}, {b}, {r},{mu,al}}

If there is a repeated element (one in the first list and other one in the second list) which I specify (for example in this case it is mu, but not r) then I remove it from both lists and create an element with the rest, for example in this case the out put should be

powers= {{rho th},{beta},{nu},{r},{ }}

subscripts={{ }, {th}, {b}, {r},{a,al}}

I got the removing part



but struggling with the rest.

UPDATE: I found how to combine the elements, now just need to remove $mu$ from them, but DeleteCases does not work.




It gives {mu rho th}, but now I cannot delete mu from it using DeleteCases.

  • $\begingroup$ I don't understand the question. Why are a and al part of the same sublist in the output? $\endgroup$ – Szabolcs Feb 12 '15 at 1:29
  • $\begingroup$ Because they stay next to $mu$. That is the point of the contraction. $\endgroup$ – Yuri Feb 12 '15 at 1:36
  • $\begingroup$ I think the problem description could use some clarification ... Why isn't the output {{ }, {a,al}, {th}, {b}, {r}}? What if there's more than one mu in both lists? The clearer the question, the better your chances for an answer. $\endgroup$ – Szabolcs Feb 12 '15 at 1:42
  • $\begingroup$ I have not used it but there is a tensor package called xact $\endgroup$ – c186282 Feb 12 '15 at 1:43
  • $\begingroup$ I said that mu can only be "one in the first list and other one in the second list" $\endgroup$ – Yuri Feb 12 '15 at 1:44

This now appears to work

c = First@Flatten@subscripts[[Flatten[Take[Position[powers, mu], All, 1]]]];
Delete[subscripts, Flatten[Take[Position[powers, mu], All, 1]]] /. mu -> c
Delete[powers, Flatten[Take[Position[powers, mu], All, 1]]]

First, find the item in subscripts that corresponds to mu in powers; call it c. Second, delete that item from subscripts. Third, replace mu in subscripts by c. Finally, delete the item containing mu from powers.

Update: cleaner and slightly more general solution

contract[key_, list1_, list2_] := Module[{pos = {Position[list1, key][[1, 1]]}, rep},
  rep = If[Flatten@list2[[pos]] != {}, First@Flatten@list2[[pos]], {}];
  {Delete[list1, pos], Delete[list2, pos] /. key -> rep /. {{}} -> {}} // MatrixForm]

Then, for instance,

contract[mu, {{mu f}, {a}, {b}, {c}, {d}, {e}} , {{}, {mu}, {beta}, {gamma}, {delta}, {eps}}]

$\left( \begin{array}{ccccc} \{a\} & \{b\} & \{\text{al}\} & \{d\} & \{e\} \\ \{\} & \{\text{beta}\} & \{\text{gamma}\} & \{\text{delta}\} & \{\text{eps}\} \\ \end{array} \right)$

  • $\begingroup$ Thank you very much, but it does not work for the following powers={{mu},{a},{b},{c},{d},{e}} subscripts={al,mu,beta,gamma,delta,eps} It removes two elements in the subscripts. There should be a little modification. Finally it could be {{mu rho},{}...} in the power list, which also does not work. $\endgroup$ – Yuri Feb 12 '15 at 2:02
  • $\begingroup$ Thanks for pointing out the lack of generality in my solution, which I believe is fixed, at least for the cases given. Note that there is a minor ambiguity in the question relating to whether deleting mu means deleting only mu or the entire item in the list that contains mu. $\endgroup$ – bbgodfrey Feb 12 '15 at 2:33
  • $\begingroup$ Still there are some cases that do not work. The whole list of possible cases powers={{mu},{a},{b},{c},{d},{e}} subscripts={{al},{mu},{beta},{gamma},{delta},{eps}}; powers={{mu f},{a},{b},{c},{d},{e}} subscripts={{},{mu},{beta},{gamma},{delta},{eps}}; powers={{},{a},{b},{c},{d},{e}} subscripts={{mu f},{mu},{beta},{gamma},{delta},{eps}} $\endgroup$ – Yuri Feb 12 '15 at 8:01
  • $\begingroup$ @g3n1uss I need clarification in order to proceed. For instance, do you wish {mu f} to transform to {f}, {}, or disappear entirely? Also, can I assume that each item in both lists will be a List itself (i.e., enclosed in curly brackets). $\endgroup$ – bbgodfrey Feb 12 '15 at 11:30
  • $\begingroup$ each pair of lists should have two elements. In your example the output should be {{a f},{b},{c},{d},{e}}; {{},{beta},{gamma},{delta},{eps}} $\endgroup$ – Yuri Feb 12 '15 at 18:23

Finally I got it

posmu1=Position[powers,mu][[1,1]]; posmu2=Position[subscripts,mu][[1,1]]; indpow1=DeleteCases[powers[[posmu1]],mu,Infinity];indpow2=DeleteCases[powers[[posmu2]],mu,Infinity]; If[indpow1!={}&&indpow2!={},powersadd=Join[indpow1 indpow2],powersadd=Join[indpow1,indpow2]]; subscriptsadd=Join[DeleteCases[subscripts[[posmu1]],mu,Infinity],DeleteCases[subscripts[[posmu2]],mu,Infinity]]; powerstmp=Delete[powers,{{posmu1},{posmu2}}]; subscriptstmp=Delete[subscripts,{{posmu1},{posmu2}}]; powersnew=Append[powerstmp,powersadd]; subscriptsnew=Append[subscriptstmp,subscriptsadd];

I need this additional to save the structure: powers should not contain comma and subscripts should.


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.