Question

I have implemented a quadtree in Mathematica. I am new to coding in a functional programming language like Mathematica, and I was wondering if I could improve this or make it more compact by better use of patterns.

(I understand that I could perhaps optimize the tree by pruning unused nodes, and there might be better data structures like k-d trees for spatial decomposition.)

Also, I am still not comfortable with the idea of copying the entire tree/expression every time a new point is added. But my understanding is that operating on the expression as a whole and not modifying the parts is the functional programming way. I’d appreciate any clarification on this aspect.

MV

The Code

ClearAll[qtMakeNode, qtInsert, insideBox, qtDraw, splitBox, isLeaf, qtbb, qtpt];

(* create a quadtree node *)
qtMakeNode[{{xmin_,ymin_}, {xmax_, ymax_}}] := 
{{}, {}, {}, {}, qtbb[{xmin, ymin}, {xmax, ymax}], {}}

(* is pt inside box? *)
insideBox[pt_, bb_] := If[(pt[[1]] <= bb[[2, 1]]) && (pt[[1]] >= bb[[1, 1]]) &&
  (pt[[2]] <= bb[[2, 2]]) && (pt[[2]] >= bb[[1, 2]]),
  True, False]

(* split bounding box into 4 children *)
splitBox[{{xmin_,ymin_}, {xmax_, ymax_}}] := {
 {{xmin, (ymin+ymax)/2}, {(xmin+xmax)/2, ymax}},
 {{xmin, ymin},{(xmin+xmax)/2,(ymin+ymax)/2}},
 {{(xmin+xmax)/2, ymin},{xmax, (ymin+ymax)/2}},
 {{(xmin+xmax)/2, (ymin+ymax)/2},{xmax, ymax}}
}

(* is node a leaf? *)
isLeaf[qt_] := If[ And @@((# == {})& /@ Join[qt[[1;;4]], {List @@ qt[[6]]}]),True, False]

(*--- insert methods ---*)

(* qtInsert #1 - return input if pt is out of bounds *)
qtInsert[qtree_, pt_] /; !insideBox[pt, List @@ qtree[[5]]]:= qtree

(* qtInsert #2 - if leaf, just add pt to node *)
qtInsert[qtree_, pt_] /; isLeaf[qtree] :=
{qtree[[1]],qtree[[2]],qtree[[3]],qtree[[4]],qtree[[5]], qtpt @@ pt} 

(* qtInsert #3 - recursively insert pt *)
qtInsert[qtree_, pt_] := 
  Module[{cNodes, currPt},
  cNodes = qtree[[1;;4]];
  (* child nodes not created? *)
  If[And @@ ((# == {})& /@ cNodes), 
    (* compute child node bounds *)
    (* create child nodes with above bounds*)
    cNodes = qtMakeNode[#]& /@ splitBox[List @@ qtree[[5]]];
  ];
  (* move curr node pt (if not empty) into child *)
  currPt = List @@ qtree[[6]];
  If[currPt != {},
    cNodes = qtInsert[#, currPt]& /@ cNodes; 
  ];
 (* insert new pt into child *)
 cNodes = qtInsert[#, pt]& /@ cNodes;
 (* return new quadtree *)
 {cNodes[[1]],cNodes[[2]], cNodes[[3]], cNodes[[4]], qtree[[5]], {}}
 ]

(* draw quadtree *)
qtDraw[qt_] := Module[{pts, bboxes},
  pts = Cases[qt, _qtpt, Infinity] /. qtpt :> List;
  bboxes = Cases[qt, _qtbb, Infinity] /. qtbb :> List;
  Graphics[{
   EdgeForm[Black],Hue[0.2], Map[Disk[#, 0.01]&, pts],
   Hue[0.7],EdgeForm[Red], FaceForm[],(Rectangle @@ #) & /@ bboxes
  },
  Frame->True
 ]
]

Usage

Clear[qt];
len = 50;
pts = RandomReal[{0, 2}, {len, 2}];
qt = qtMakeNode[{{0.0, 0.0}, {2.0, 2.0}}];
Do[qt = qtInsert[qt, pts[[i]]], {i, 1, len}]
qtDraw[qt]

Output

Answer 1

Here is a more compact version. It uses the same data structure as the original version. The functions splitBox and insideBox are essentially the same as well (just written in a slightly different way).

Instead of adding points one-by-one, the initial box contains all the points at the beginning so there is no need for the qtInsert routines. In each recursion step, the boxes containing more than one point are split and the points are distributed over the sub-boxes. This means that all nodes with more than one point are leafs so there is no need to check for that either.

qtMakeNode[bb_, pts_] := {{}, {}, {}, {}, qtbb @@ bb, pts}

splitBox[bx_] := splitBox[{min_, max_}] := {min + #, max + #}/2 & /@  
  Tuples[Transpose[{min, max}]]


insideBox[pt_, bb_] := bb[[1, 1]] <= pt[[1]] <= bb[[2, 1]] && 
  bb[[1, 2]] <= pt[[2]] <= bb[[2, 2]]

distribute[qtree_] := Which[
  Length[qtree[[6]]] == 1, 
    (* no points in node -> return node unchanged *)
  qtree,

  Length[qtree[[6]]] == 1, 
    (* one point in node -> replace head of point with qtpt and return node *)
  ReplacePart[qtree, 6 -> qtpt @@ qtree[[6, 1]]],

  Length[qtree[[6]]] > 1, 
    (* multiple points in node -> create sub-nodes and distribute points *)
    (* apply distribute to sub-nodes *) 
  Module[{spl = splitBox[qtree[[5]]], div, newtreelist},
   div = Cases[qtree[[6]], a_ /; insideBox[a, #], 1] & /@ spl;
   ReplacePart[qtree, 
    Join[Table[i -> distribute[qtMakeNode[spl[[i]], div[[i]]]], {i, 4}], 
      {6 -> {}}]]]]

Example (using the original version of qtDraw):

len = 50;
pts = RandomReal[{0, 2}, {len, 2}];
qt = makeTree[qtMakeNode[{{0.0, 0.0}, {2.0, 2.0}}, pts]];
qtDraw[qt]

Result: