4
$\begingroup$

Can somebody help me with a function f such that it extract all sub expressions (i.e. looking down the expression tree) from any expression given to it and also a list of heads it encounters as it moves down the expression tree.

For example, f@(Sin[Log[Cos[a], Tan[Log[a, b]]]] // Inactivate) gives { { Inactive[Sin][Inactive[Log][Inactive[Cos][a], Inactive[Tan][Inactive[Log][a, b]]]], Inactive[Log][Inactive[Cos][a], Inactive[Tan][Inactive[Log][a, b]]], Inactive[Cos][a], Inactive[Tan][Inactive[Log][a, b]], a, Inactive[Log][a,b], a, b }, { Inactive[Sin], Inactive[Log], Inactive[Cos], Inactive[Tan], Inactive[Log] } }

Note: order of occurrence and duplicacy must be maintained

Explanation of Order of sub expressions (also the order in which heads are removed to move to the next sub expression)

first the full expression

enter image description here

next the expression starting from the second level (Head Inactive[Sin] is removed)

enter image description here

next the two expressions at level 3 (Head Inactive[Log] is removed)

enter image description here

enter image description here

next the two expression at level 4 from left to right (next the Head Inactive[Cos] and then Inactive[Tan] is removed moving from left to right)

enter image description here

enter image description here

finally the two expressions at the last level from left to right (lastly the Head Inactive[Log] is removed to arrive at the last level)

enter image description here

enter image description here

This is the general order i want to have for sub expressions and the also the order of removal of Heads.

$\endgroup$
  • $\begingroup$ I want inactive to be bound to the head it is making inactive, so in the example the output must be same except instead of Sin,Log,Cos,Tan there would be Inactive[Sin],Inactive[Log],Inactive[Cos],Inactive[Tan] $\endgroup$ – user13892 Jul 2 '16 at 18:01
  • 1
    $\begingroup$ I have attached the picture of the expression tree. Start from the full expression and then start cutting the heads from the top leaving the expressions below. For example first subexpression is the input expression itself. Next is the expression without the outer Inactive[Sin]. Next the expression in the two branches below and so on. $\endgroup$ – user13892 Jul 2 '16 at 19:02
4
$\begingroup$

Code

head[h_[___]] := h;
head[atom_] := Nothing;

deconstruct[expr_] := With[
  {temp = Flatten[Level[expr, {#}]& /@ Range[0, Depth[expr]], 1]},
  {temp, head /@ temp}
];

Usage

deconstruct[Sin[Log[Cos[a], Tan[Log[a, b]]]] // Inactivate]

(*
  {
   {Inactive[Sin][Inactive[Log][Inactive[Cos][a], Inactive[Tan][Inactive[Log][a, b]]]], 
    Inactive[Log][Inactive[Cos][a], Inactive[Tan][Inactive[Log][a, b]]],
    Inactive[Cos][a], 
    Inactive[Tan][Inactive[Log][a, b]], 
    a, 
    Inactive[Log][a, b], 
    a, 
    b
   }, 
   {Inactive[Sin], 
    Inactive[Log], 
    Inactive[Cos], 
    Inactive[Tan], 
    Inactive[Log]}
   }

*)
$\endgroup$
  • $\begingroup$ Thank you this is exactly what i was after. $\endgroup$ – user13892 Jul 3 '16 at 20:52
3
$\begingroup$

Second answer

The OP's desired order:

oporder = {
 {Inactive[Sin][Inactive[Log][Inactive[Cos][a], Inactive[Tan][Inactive[Log][a, b]]]], 
    Inactive[Log][Inactive[Cos][a], Inactive[Tan][Inactive[Log][a, b]]], Inactive[Cos][a], 
    Inactive[Tan][Inactive[Log][a, b]], a, Inactive[Log][a, b], a, b},
 {Inactive[Sin], Inactive[Log], Inactive[Cos], Inactive[Tan], 
    Inactive[Log]}};

SetAttributes[ff, HoldFirst];
ff[expr_] := Reap[
   Do[
    (Sow[#, "expr"]; Sow[Head[#], "head"] & /@ #) &@Level[expr, {k}],
    {k, 0, Depth[expr] - 1}],
   {"expr", "head"},
   Sequence @@ If[# === "head", Replace[#2, _?AtomQ -> Nothing, 1], Flatten@#2] &] // Last

This is similar to the first approach except that it goes down the expression level by level, so that no reversing is needed. One can remove the Flatten if if having the expressions collected by level happens to be desired.

ff[Sin[Log[Cos[a], Tan[Log[a, b]]]] // Inactivate]
(*
  {{Inactive[Sin][Inactive[Log][Inactive[Cos][a], Inactive[Tan][Inactive[Log][a, b]]]], 
    Inactive[Log][Inactive[Cos][a], Inactive[Tan][Inactive[Log][a, b]]],
     Inactive[Cos][a], Inactive[Tan][Inactive[Log][a, b]], a, Inactive[Log][a, b], a, b},
   {Inactive[Sin], Inactive[Log], Inactive[Cos], Inactive[Tan], Inactive[Log]}}
*)

% === oporder
(*  True  *)

First answer

How's this? [Update remark: Reverse reverses not only the depths of the levels but the order at each level]

SetAttributes[f, HoldFirst];
f[expr_] := Reap[
   Scan[
    (Sow[#, "expr"]; Sow[Head[#], "head"]) &,
    expr,
    Infinity],
   {"expr", "head"},
   Sequence @@ 
     If[# === "head", #2 /. {Symbol -> Nothing}, Reverse@#2] &
   ] // Last

f[Sin[Log[Cos[a], Tan[Log[a, b]]]] // Inactivate]
(*
  {{
   Inactive[Log][Inactive[Cos][a],
   Inactive[Tan][Inactive[Log][a, b]]],
   Inactive[Tan][Inactive[Log][a, b]],
   Inactive[Log][a, b],
   b,
   a, 
   Inactive[Cos][a],
   a},
   {
    Inactive[Cos],
    Inactive[Log],
    Inactive[Tan], 
    Inactive[Log]
    }
   }
*)

(I wasn't really sure whether the Inactivate was suppose to be part of f or of the expression. I was also unsure about the order and whether Reverse does what you want.)

$\endgroup$
  • $\begingroup$ Hi Michael your code is almost what i want but can you please make the output order exactly what i have written. Also please make it output the full expression as well. I can't do this myself since i have no understanding of how Reap, Sow and Scan works. Thank you $\endgroup$ – user13892 Jul 2 '16 at 18:58
  • $\begingroup$ @user13892 How to define the order? "Scan traverses the parts of expr in a depth-first order, with leaves visited before roots," according to the docs. What order do you want in general (not just the specific example)? $\endgroup$ – Michael E2 Jul 2 '16 at 19:02
  • $\begingroup$ see my updated question with pictures describing the general methodology to move to the next subexpression and also collect the heads in the order they are removed. $\endgroup$ – user13892 Jul 2 '16 at 19:28
  • $\begingroup$ replacing a,b by actual numbers like 2, 2.0 results in Integer, Real appearing in the list of Heads removed. $\endgroup$ – user13892 Jul 3 '16 at 20:55
1
$\begingroup$

Your use of the head Inactive[] complicates this a bit, but generally, you'll want to do this:

DeleteCases[DeleteCases[Reap[Scan[
 Sow[#] &, (Sin[Log[Cos[a], Tan[Log[a, b]]]] // Inactivate), {0, 
  Infinity}, Heads -> True]][[2, 1]], Inactive[x_]], Inactive]

{Sin, Log, Cos, a, Inactive[Cos][a], Tan, Log, a, b, Inactive[Log][a, b], Inactive[Tan][Inactive[Log][a, b]], Inactive[Log][Inactive[Cos][a], Inactive[Tan][Inactive[Log][a, b]]], Inactive[Sin][ Inactive[Log][Inactive[Cos][a], Inactive[Tan][Inactive[Log][a, b]]]]}

$\endgroup$
  • $\begingroup$ This is treating Inactive as a separate head. I want it to be bound to the head it is making inactive $\endgroup$ – user13892 Jul 2 '16 at 18:06
  • $\begingroup$ @user13892 How about this then? $\endgroup$ – Feyre Jul 2 '16 at 18:36

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.