Numbering nested list according with Depth (or Level)

Question

(This question is slightly similar with Sequentially numbering a nested list, but not exactly the same.)

What I want

Say I have a nested list

lst = {{"X", {{"X", "X"}, {{"X", "X"}, "X"}, "X"}, "X"}, "X", "X"};

What I would like to do is to label each "X" with a number according with its Depth/Level, that is something like this

{{{2,"X"},{{{4,"X"},{4,"X"}},{{{5,"X"},{5,"X"}},{4,"X"}},{3,"X"}},{2,"X"}},{1,"X"},{1,"X"}}

What I tried

I used a dumb way to achieve my goal.

First I label each "X" with a unique label:

labelLst = lst /. "X" :> RandomReal[]

Then get their positions:

posSet = Position[labelLst, #][[1]] & /@ Flatten[labelLst]

Then label "X"s with its Depth:

ReplacePart[lst, Function[pos, pos -> {
     Length[pos], lst[[##]] & @@ pos
     }] /@ posSet]

My question

I think taking the aid of extra real-number labels is a bit cheating and inelegant, so I want to ask for a more elegant method for this. By saying elegant, I'm thinking of something pure list-manipulations. Any idea would be helpful.

---

Why I need this:

I'm trying to format the result of Trace for external plain-text viewer. Label numbers according with Levels eventually lead to human friendly indents.

Clear[levelIndentFunc]
levelIndentFunc[lst_] :=
 Module[{labelLst, posSet},
  labelLst = lst /. e_HoldForm :> RandomReal[];
  posSet = Position[labelLst, #][[1]] & /@ Flatten[labelLst];
  ReplacePart[lst, Function[pos, pos -> StringJoin[Flatten@{
            ConstantArray["\t", Length[pos] - 1],
            StringTake[
             ToString[lst[[##]] & @@ pos, InputForm], {10, -2}]
            }]] /@ posSet] // Flatten // Riffle[#, "\n"] & // StringJoin
  ]

Example:

traceRes = Trace[Reduce[x^2 == -1, x], TraceInternal -> True, TraceDepth -> 3];
Export["tracePrintTest.txt", levelIndentFunc@traceRes, "String"]

Open tracePrintTest.txt in external text viewer (here Sublime Text with Mathematica syntax highlight plugin):

Edit:

With the help of Mr.Wizard's MapIndexed function, the formatting function levelIndentFunc can be simplified to

Clear[levelIndentFunc]
levelIndentFunc[lst_] :=
 MapIndexed[
    {ConstantArray["\t", Length[#2] - 1], #1, "\n"} &,
    lst /. e_HoldForm :> StringTake[ToString[e, InputForm], {10, -2}],
    {-1}] // Flatten // StringJoin

Answer 1

I think you may merely want MapIndexed. For your first example:

lst = {{"X", {{"X", "X"}, {{"X", "X"}, "X"}, "X"}, "X"}, "X", "X"};

f[s_String, pos_] := {Length@pos, s}
f[other_, _] := other

MapIndexed[f, lst, -1]

{{{2,"X"},{{{4,"X"},{4,"X"}},{{{5,"X"},{5,"X"}},{4,"X"}},{3,"X"}},{2,"X"}},{1,"X"},{1,"X"}}

Alternatively, your own formulation may be simplified:

ReplacePart[lst,
  # -> {Length@#, lst ~Extract~ #} & /@ Position[lst, s_String]
]

{{{2,"X"},{{{4,"X"},{4,"X"}},{{{5,"X"},{5,"X"}},{4,"X"}},{3,"X"}},{2,"X"}},{1,"X"},{1,"X"}}

In either method the pattern s_String defines which objects are to be indexed. A simpler/faster method for all atomic objects (level {-1}) is:

MapIndexed[{Length@#2, #} &, lst, {-1}]

{{{2,"X"},{{{4,"X"},{4,"X"}},{{{5,"X"},{5,"X"}},{4,"X"}},{3,"X"}},{2,"X"}},{1,"X"},{1,"X"}}

Answer 2

This obviously can't hold a candle to Mr. Wizard's solutions, and is a bit hackish as well, but anyway:

Fold[Replace[#1, "X" -> {#2, "A"}, {#2}] &, lst, 
  Range[Depth[lst] - 1]] /. "A" -> "X"

If there's anyway to use this approach without using the dummy symbol, I'd like to know about it. -> Edit: See Mr. Wizard's solution in the comments.

Answer 3

lst = {{"X", {{"X", "X"}, {{"X", "X"}, "X"}, "X"}, "X"}, "X", "X"};

SetAttributes[f, Listable]

Map[f, lst, {1, Infinity}];

ClearAttributes[f, Listable]

%% //. {
  f[x_String] :> {1, x},
  f[{i_Integer, x_String}] :> {i + 1, x}}

{{{2, "X"}, {{{4, "X"}, {4, "X"}}, {{{5, "X"}, {5, "X"}}, {4, 
     "X"}}, {3, "X"}}, {2, "X"}}, {1, "X"}, {1, "X"}}