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.

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?

share|improve this question
add comment

1 Answer

up vote 8 down vote accepted

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

rules=(Node[p_,#1-1]->{Node[p-#2/2,#1],Node[p+#2/2,#1]})&@@@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

Update

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

share|improve this answer
    
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... –  Simon Lausen Feb 17 '13 at 15:34
    
@SimonLausen Please see my update at the end of the answer. –  halirutan Feb 17 '13 at 22:41
    
Thanks again! This function will save me and my classmates for a lot of work! –  Simon Lausen Feb 20 '13 at 19:20
add comment

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.