5
$\begingroup$

Suppose I have several types of expressions (in some random order) of the form

Power[Subscript[g, a], μ] which is $g_a{}^\mu$

Subscript[Power[g, a], α]] which is $g^a{}_\alpha$

Power[g, Times[ρ, θ]] which is $g^{\rho\theta}$

Subscript[Subscript[g, a], α] which is $g_{a \alpha}$

I need to extract subscript and superscript regardless of the type of the expression.

$\endgroup$
5
$\begingroup$
exprs = {Power[Subscript[g, a], μ ], Subscript[Power[g, a], α ],
         Power[g, Times[ρ, θ] ], Subscript[Subscript[g, a], α] }

Cases[#, (Power | Subscript)[_, y_] :> y, {0, Infinity}]&/@ exprs
(* {{a, μ}, {a, α}, {θ ρ}, {a, α}} *)

Update: To get separate lists of powers and subscripts:

{powers, subscripts} = Function[{head}, Cases[#, head[_, y_] :> y, {0, Infinity}] & /@ exprs] /@ 
                       {Power, Subscript}
(* {{{μ}, {a}, {θ ρ}, {}}, {{a}, {α}, {}, {a, α}}} *)
| improve this answer | |
$\endgroup$
  • $\begingroup$ Thank you very much! But in this case $g_{ab}$ and $g^{ab}$ give the same output $\{a b\}$. They should be distinguishable $\endgroup$ – Yuri Feb 11 '15 at 5:01
  • 1
    $\begingroup$ @g3n1uss, please see the update. $\endgroup$ – kglr Feb 11 '15 at 5:08
  • $\begingroup$ Great! Thank you very much! $\endgroup$ – Yuri Feb 11 '15 at 5:15
2
$\begingroup$

You did not specify an output format. Nevertheless I propose:

f[b_^su_ | Subscript[b_, sb_]] :=
  Join[f@b, {Up[su], Down[sb]}] ~Cases~ _[_]

f[else_] := {}

Example:

test = {
  Power[Subscript[g, a], μ],
  Subscript[Power[g, a], α],
  Power[g, Times[ρ, θ]],
  Subscript[Subscript[g, a], α]
 };

f /@ test
{{Down[a], Up[μ]}, {Up[a], Down[α]}, {Up[θ ρ]}, {Down[a], Down[α]}}

Up and Down serve to label superscripts and subscripts.

| improve this answer | |
$\endgroup$
1
$\begingroup$

I propose to use a custom structure

add[{a___}, (List | Times)[b___] | c_] := {b, c, a}
script[a_^b_, sub_: {}, sup_: {}] := script[a, sub, add[sup, b]];
script[Subscript[a_, b_], sub_: {}, sup_: {}] := script[a, add[sub, b], sup];

script /@ exprs
(*{script[g, {a}, {μ}], script[g, {α}, {a}], script[g, {}, {θ, ρ}], script[g, {a, α}, {}]}*)

It is very clear and allows you further pattern-matching and other abilities.

Also you can add custom formatting

script /: MakeBoxes[script[g_, sub_, sup_], StandardForm] := 
 SubsuperscriptBox[ToBoxes@g, RowBox[ToBoxes /@ sub], RowBox[ToBoxes /@ sup]]

to display the result as

enter image description here

| improve this answer | |
$\endgroup$

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.