a function to extract all subexpressions from an expression

Question

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

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

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

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)

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)

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

Answer 1

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]}
   }

*)

Answer 2

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.)

Answer 3

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]]]]}