1997 Mathematica Developer Conference Programming Challenge

The problem was to create a function TreeGraphic, producing a Graphics object like this:

The hard part of this problem, as is very often the case with "real life" problems, was to figure out exactly what the problem is in the first place. When you start with an intuitive idea of what you want, it can be difficult to turn that idea into the kind of precise description that is necessary to write a program.

Here is one possible solution:

Some Submitted Pictures

Many people found (perhaps unintentionally) interesting variations on the graphic given.

The Winning Program

Leaves[0,n_]:= &pgr;/2 + n*2&pgr;/3;
Leaves[k_,n_]:= 
	Leaves[k-1,Quotient[n,2]]+(-1)^Mod[n,2]*&pgr;/(3*2^k); 
Leaves[k_]:= Table[Leaves[k,n],{n,0,3*2^k-1}];
Polar[r_,th_]:= {r Cos[th],r Sin[th]};
Pts[k_]:= Polar[k+1,#]& /@ Leaves[k];
Lines[0] = Line[{{0,0},#}]& /@ Pts[0]
Lines[k_]:=
Apply[{Line[{#1,First[#2]}],Line[{#1,Last[#2]}]}&,
Transpose[{Pts[k-1],Partition[Pts[k],2]}],{1}];

TreeGraphic[d_Integer]:=
Show[Graphics[Table[Lines[k],{k,0,d}],
{AspectRatio->Automatic}]];

Examples

TreeGraphic[1];

TreeGraphic[2];

TreeGraphic[3];