I'm trying to make a function that generates a tree for spin spin analysis in spectroscopy. I though it would be pretty easy, but I'm totally stocked.

The tree should look something like this: Spin Spin analysis

where the listed frequencies are the distance between the "generations".

I have tried with this: FoldList[{#1 + #2, #1 - #2} &, 0, {jad,jab,jac}] where I get the right x-values, but rearranging these values to give me the right lines is where is where it all stops for me.

What should I do?


1 Answer 1


Your input is the frequencies at each generation. Let's write them down

freq = {{1, 5.15}, {2, 1.47}, {3, 1.47}};

For convenience we might define one of your lines to be a Node[p,g] where p is the x-position and g is the generation. With this you can directly draw lines or use the positions with a Graph.

Let's have a look how we can create the complete tree from the top. The top node is Node[0,0]. When we have a `Node[p,g] at a specific level and with the correct x-position given, we can easily calculate the two children of it by

{Node[p-f/2, g+1], Node[p+f/2, g+1]}

where f is the frequency in the next level. So for instance for Node[0,0] and the frequency 5.12 at the next level 1 we get

{Node[-2.56,1], Node[2.56,1]}

When this is understood, it is not difficult to create a list of rules from your frequency list freq

 {Node[p_,0]->{Node[-2.575+p,1],Node[2.575 +p,1]},
  Node[p_,1]->{Node[-0.735+p,2],Node[0.735 +p,2]},
  Node[p_,2]->{Node[-0.735+p,3],Node[0.735 +p,3]}

What's left is to apply this set of rules on the starting Node[0,0] until nothing changes anymore. This can be done using FixedPoint, where we here want to use FixedPointList to store the results in between, because you want to have Node[0,0] in the final result.

nodes = Most@FixedPointList[# /. rules &, Node[0, 0]]

The result contains the position information for all levels and the list-nesting shows, which nodes are on which level in the tree. Using Graph and its Property you can set up a tree looking like your image above.

The most easy way to visualize the correctness is to simply transform the nodes into Line directives and draw them:

Graphics[{Opacity[.5], Thickness[.02], 
   nodes /. Node[p_, g_] :> Line[{{p, -g}, {p, -g - .5}}]}, 
 AspectRatio -> 1]

I used Opacity so that it becomes visible where the two lines in the last level overlap:

Mathematica graphics


You asked in the comment

How do I draw the lines between the nodes?

Exactly in the same way. I showed you how to calculate the positions of thick lines. The edges of the tree can be calculated in the same way. Therefore, let's introduce additionally an Edge[x1, x2, g] type which connects two generations. We can include the rules for the edges in our rules variable and with a bit of adaption we get

freq = {{1, 5.15}, {2, 1.47}, {3, 1.47}};
rules = (Node[p_, #1 - 1] -> {Node[p - #2/2, #1], Node[p + #2/2, #1], 
       Edge[p, p - #2/2, #1], Edge[p, p + #2/2, #1]}) & @@@ freq;
tree = Most@FixedPointList[# /. rules &, Node[0, 0]];

draw = {Node[p_, g_] :> {Opacity[.5], Thickness[.02], Blue, 
    Line[{{p, -g}, {p, -g - .5}}]}, 
  Edge[x1_, x2_, g_] :> {Thickness[.005], Opacity[1], Black, 
    Line[{{x1, -g + .5}, {x2, -g}}]}

Graphics[tree /. draw, AspectRatio -> 1]

For a better readability I packed the rules which transform the tree into draw directives into a separate variable draw

Mathematica graphics

  • $\begingroup$ Thank you very much! Thats an elegant solution I couldn't have though of my self. But I have one more question, if its okay? The function is useful as spin spin analysis as it is now, but just for the appearance: How do I draw the lines between the nodes? I have tried myself, but can only draw lines between them all, and not only the respective ones... $\endgroup$
    – Simon
    Commented Feb 17, 2013 at 15:34
  • $\begingroup$ @SimonLausen Please see my update at the end of the answer. $\endgroup$
    – halirutan
    Commented Feb 17, 2013 at 22:41
  • $\begingroup$ Thanks again! This function will save me and my classmates for a lot of work! $\endgroup$
    – Simon
    Commented Feb 20, 2013 at 19:20

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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