Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

(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):

traceprint

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
share|improve this question
2  
Have you looked at MapIndexed? –  Mr.Wizard May 29 '13 at 6:33
    
@Mr.Wizard Thanks! Almost forgot it can scan different levels! –  Silvia May 29 '13 at 6:40
    
Glad I could jog your memory. :-) I added a simplification of your own method that I believe is equivalent. I hope it helps. –  Mr.Wizard May 29 '13 at 6:45

3 Answers 3

up vote 9 down vote accepted

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"}}
share|improve this answer
    
Really appreciate! :D –  Silvia May 29 '13 at 6:54
    
@Silvia You're welcome. I made a third update to the question with a simpler form that may or may not be adaptable to your problem. (Other levelspec values could be used.) –  Mr.Wizard May 29 '13 at 6:57
    
Thanks. I will ToString all atomic objects before feeding to the indent function, so I think all your version will work perfectly. –  Silvia May 29 '13 at 7:05

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.

share|improve this answer
1  
I always like alternatives. +1 As for eliminating the substitution, how about: Fold[Replace[#1, "X" -> {#2, "X"}, {#2}] &, lst, Reverse @ Range[Depth[lst] - 1]] ? Also, you could use a rule such as p : "X" :> {#2, p} which would be useful when not all indexed expressions are identical. –  Mr.Wizard May 29 '13 at 7:09
    
@Mr.Wizard Great "backward" thinking! :D –  Aky May 29 '13 at 7:13
    
:-) By the way, Reverse @ Range[Depth[lst] - 1] could be written Range[Depth[lst] - 1, 1, -1] as you prefer. –  Mr.Wizard May 29 '13 at 7:14
    
@Mr.Wizard Fortunately that's one thing I do know, lol (referring to the negative step in Range). However I still have to work out where the named pattern would come in useful in this type of problem. Could you give an example? –  Aky May 29 '13 at 7:21
    
Sorry, I didn't express myself well. I mean if e.g. lst = {{"A", {{"Q", "C"}, {{"J", "M"}, "B"}, "R"}, "I"}, "X", "T"}; and you want to index every string, then: Fold[Replace[#1, p_String :> {#2, p}, {#2}] &, lst, Range[Depth[lst] - 1, 1, -1]] –  Mr.Wizard May 29 '13 at 21:18
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"}}
share|improve this answer
    
+1 Nice, I like it! –  Aky May 29 '13 at 7:30
1  
Interesting method! –  Silvia May 29 '13 at 7:33
    
You can MapAll or //@ but then set first rule to {0, x}. –  BoLe May 29 '13 at 7:35
    
Everybody has their unique angle of view on Mathematica. Somebody like "arrows" while somebody prefer "@"s :) –  Silvia May 29 '13 at 8:31
2  
@BoLe Off-topic, but have the GIFs in your blog been generated using Mathematica? They're quite cool! –  Aky May 29 '13 at 9:01

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.