How to make a simple tree yourself with defined distances for each generation?

Question

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:

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?

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

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:

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