http://mathling.com/geometric/tree/quadtree  library module

Function Index

• add-points($node as map(xs:string,item()*), $points as map(xs:string,item()*)*) as map(xs:string,item()*)
• all-points($quadtree as map(xs:string,item()*), $node as map(xs:string,item()*)) as map(xs:string,item()*)*
• all-points($quadtree as map(xs:string,item()*)) as map(xs:string,item()*)*
• ancestors($node as map(xs:string,item()*), $quadtree as map(xs:string,item()*)) as map(xs:string,item()*)*
• bottom-left($node as map(xs:string,item()*)) as xs:integer
• bottom-left($node as map(xs:string,item()*), $quadtree as map(xs:string,item()*)) as map(xs:string,item()*)?
• bottom-right($node as map(xs:string,item()*)) as xs:integer
• bottom-right($node as map(xs:string,item()*), $quadtree as map(xs:string,item()*)) as map(xs:string,item()*)?
• capacity($quadtree as map(xs:string,item()*)) as xs:integer
• children($node as map(xs:string,item()*)) as xs:integer*
• children($node as map(xs:string,item()*), $quadtree as map(xs:string,item()*)) as map(xs:string,item()*)*
• contains($box as map(xs:string,item()*), $point as map(xs:string,item()*)) as xs:boolean
• depth($node as map(xs:string,item()*)) as xs:integer
• down-neighbour($node as map(xs:string,item()*), $quadtree as map(xs:string,item()*)) as map(xs:string,item()*)?
• extent($item as map(xs:string,item()*)) as map(xs:string,item()*)
• find-nearest($quadtree as map(xs:string,item()*), $point as map(xs:string,item()*), $radius as xs:double) as map(xs:string,item()*)?
• find-range($quadtree as map(xs:string,item()*), $box as map(xs:string,item()*)) as map(xs:string,item()*)*
• find-range($quadtree as map(xs:string,item()*), $id as xs:integer, $box as map(xs:string,item()*)) as map(xs:string,item()*)*
• get-node($quadtree as map(xs:string,item()*), $id as xs:integer) as map(xs:string,item()*)?
• id($node as map(xs:string,item()*)) as xs:integer
• insert($quadtree as map(xs:string,item()*), $p as map(xs:string,item()*)) as map(xs:string,item()*)
• insert($quadtree as map(xs:string,item()*), $id as xs:integer, $p as map(xs:string,item()*)) as item()*
• insert-all($quadtree as map(xs:string,item()*), $points as map(xs:string,item()*)*) as map(xs:string,item()*)
• is-leaf($node as map(xs:string,item()*)) as xs:boolean
• is-root($node as map(xs:string,item()*)) as xs:boolean
• left-neighbour($node as map(xs:string,item()*), $quadtree as map(xs:string,item()*)) as map(xs:string,item()*)?
• minimum-extent($quadtree as map(xs:string,item()*)) as xs:double
• nearest-node($quadtree as map(xs:string,item()*), $point as map(xs:string,item()*), $radius as xs:double) as map(xs:string,item()*)?
• nearest-node($quadtree as map(xs:string,item()*), $point as map(xs:string,item()*)) as map(xs:string,item()*)?
• nearest-point($quadtree as map(xs:string,item()*), $point as map(xs:string,item()*), $radius as xs:double) as map(xs:string,item()*)?
• nearest-point($quadtree as map(xs:string,item()*), $point as map(xs:string,item()*)) as map(xs:string,item()*)?
• neighbours($node as map(xs:string,item()*), $quadtree as map(xs:string,item()*)) as map(xs:string,item()*)*
• next-id($quadtree as map(xs:string,item()*)) as xs:integer
• node($id as xs:integer, $extent as map(xs:string,item()*), $points as array(map(xs:string,item()*)), $parent as xs:integer, $depth as xs:integer, $top-left as xs:integer, $top-right as xs:integer, $bottom-left as xs:integer, $bottom-right as xs:integer) as map(xs:string,item()*)
• node($id as xs:integer, $parent as xs:integer, $depth as xs:integer, $extent as map(xs:string,item()*)) as map(xs:string,item()*)
• nodes($quadtree as map(xs:string,item()*)) as map(xs:string,item()*)*
• num-nodes($quadtree as map(xs:string,item()*)) as xs:integer
• num-points($node as map(xs:string,item()*)) as xs:integer
• parent($node as map(xs:string,item()*)) as xs:integer
• parent($node as map(xs:string,item()*), $quadtree as map(xs:string,item()*)) as map(xs:string,item()*)?
• points($node as map(xs:string,item()*)) as map(xs:string,item()*)*
• put-node($quadtree as map(xs:string,item()*), $id as xs:integer, $node as map(xs:string,item()*)) as map(xs:string,item()*)
• quadrant($node as map(xs:string,item()*), $parent as map(xs:string,item()*)) as xs:integer
• quadtree() as map(xs:string,item()*)
• quadtree($points as map(xs:string,item()*)*) as map(xs:string,item()*)
• quadtree($points as map(xs:string,item()*)*, $extent as map(xs:string,item()*)) as map(xs:string,item()*)
• quote($items as map(xs:string,item()*)*) as xs:string
• right-neighbour($node as map(xs:string,item()*), $quadtree as map(xs:string,item()*)) as map(xs:string,item()*)?
• root($quadtree as map(xs:string,item()*)) as map(xs:string,item()*)
• set-capacity($quadtree as map(xs:string,item()*), $capacity as xs:integer) as map(xs:string,item()*)
• set-children($node as map(xs:string,item()*), $top-left as xs:integer, $top-right as xs:integer, $bottom-left as xs:integer, $bottom-right as xs:integer) as map(xs:string,item()*)
• set-extent($quadtree as map(xs:string,item()*), $extent as map(xs:string,item()*)) as map(xs:string,item()*)
• set-minimum-extent($quadtree as map(xs:string,item()*), $minimum-extent as xs:double) as map(xs:string,item()*)
• size($quadtree as map(xs:string,item()*)) as xs:integer
• split($quadtree as map(xs:string,item()*), $id as xs:integer) as map(xs:string,item()*)
• top-left($node as map(xs:string,item()*)) as xs:integer
• top-left($node as map(xs:string,item()*), $quadtree as map(xs:string,item()*)) as map(xs:string,item()*)?
• top-right($node as map(xs:string,item()*)) as xs:integer
• top-right($node as map(xs:string,item()*), $quadtree as map(xs:string,item()*)) as map(xs:string,item()*)?
• up-neighbour($node as map(xs:string,item()*), $quadtree as map(xs:string,item()*)) as map(xs:string,item()*)?
• visit($quadtree as map(xs:string,item()*), $callback as function(map(xs:string,item()*), map(xs:string,item()*)) as item()*) as item()*
• visit($quadtree as map(xs:string,item()*), $callback as function(map(xs:string,item()*), map(xs:string,item()*)) as item()*, $prune as xs:boolean) as item()*
• visit($quadtree as map(xs:string,item()*), $id as xs:integer, $callback as function(map(xs:string,item()*), map(xs:string,item()*)) as item()*, $prune as xs:boolean) as item()*

Imports

import module namespace util="http://mathling.com/core/utilities"
       at "../core/utilities.xqy"

import module namespace box="http://mathling.com/geometric/rectangle"
       at "../geo/rectangle.xqy"

import module namespace errors="http://mathling.com/core/errors"
       at "../core/errors.xqy"

import module namespace point="http://mathling.com/geometric/point"
       at "../geo/point.xqy"

Variables

Functions

declare function this:quadtree() as map(xs:string,item()*)
{
  map {
    "kind": "quadtree",
    "extent": $this:DEFAULT-EXTENT,
    "min-extent": $this:DEFAULT-MIN-EXTENT,
    "capacity": $this:DEFAULT-CAPACITY,
    "nodes": array { this:node(1, 0, 0, $this:DEFAULT-EXTENT) }
  }
}

declare function this:quadtree(
  $points as map(xs:string,item()*)*
) as map(xs:string,item()*)
{
  let $extent := box:box(
    min($points!point:px(.)), min($points!point:py(.)),
    max($points!point:px(.)), max($points!point:py(.))
  )
  return (
    this:quadtree()=>
      this:set-extent($extent)=>
      this:insert-all($points)
  )
}

declare function this:quadtree(
  $points as map(xs:string,item()*)*,
  $extent as map(xs:string,item()*)
) as map(xs:string,item()*)
{
  this:quadtree()=>
    this:set-extent($extent)=>
    this:insert-all($points)
}

declare function this:set-minimum-extent(
  $quadtree as map(xs:string,item()*),
  $minimum-extent as xs:double
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($minimum-extent < 3*$this:ε) then errors:error("GEOM-BAD-EXTENT", ($minimum-extent, 3*$this:ε)) else (),
  $quadtree=>map:put("min-extent", $minimum-extent)
}

declare function this:set-capacity(
  $quadtree as map(xs:string,item()*),
  $capacity as xs:integer
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>map:put("capacity", $capacity)
}

declare function this:set-extent(
  $quadtree as map(xs:string,item()*),
  $extent as map(xs:string,item()*)
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if (this:num-nodes($quadtree) !=1 or this:size($quadtree)!=0)
  then errors:error("GEOM-API-MISUSE", ("set-extent", "quadtree with points"))
  else if (not(point:valid(box:min-point($extent))) or not(point:valid(box:max-point($extent))))
  then errors:error("GEOM-BADREGION", ($extent, "quad:set-extent"))
  else (
    let $extent := box:box(box:min-point($extent), box:max-point($extent)=>point:add(point:point($this:ε, $this:ε)))
    return (
      $quadtree=>
        map:put("extent", $extent)=>
        this:put-node(1, this:get-node($quadtree, 1)=>map:put("extent", $extent))
    )
  )
}

declare function this:size(
  $quadtree as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  count(this:all-points($quadtree))
}

declare function this:num-nodes(
  $quadtree as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree("nodes")=>array:size()
}

declare function this:nodes(
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree("nodes")=>array:flatten()
}

declare function this:root(
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>this:get-node(1)
}

declare function this:get-node(
  $quadtree as map(xs:string,item()*),
  $id as xs:integer
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($id = 0) then () else $quadtree("nodes")($id)
}

declare function this:minimum-extent(
  $quadtree as map(xs:string,item()*)
) as xs:double
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree("min-extent")
}

declare function this:capacity(
  $quadtree as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree("capacity")
}

declare function this:quote(
  $items as map(xs:string,item()*)*
) as xs:string
{
  string-join(
    for $item in $items return (
      if (util:kind($item)="quadtree") then (
        "quad:"||$item("capacity")||"["||box:quote(box:decimal($item("extent"),1))||"
  "||
           string-join(this:quote(array:flatten($item("nodes"))),"
    ")||
        "]"
      ) else ( (: node :)
        "node-"||$item("id")||"["||box:quote(box:decimal($item("extent"),1))||" ("||
          $item("top-left")||","||$item("top-right")||","||$item("bottom-left")||","||$item("bottom-right")||
        ") ("||
          point:quote(point:decimal(array:flatten($item("points")),1))||
        ")"||
        "]"
      )
    ),
    " "
  )
}

declare function this:is-leaf(
  $node as map(xs:string,item()*)
) as xs:boolean
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  this:top-left($node) = 0
}

declare function this:is-root(
  $node as map(xs:string,item()*)
) as xs:boolean
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  this:id($node) = 1
}

declare function this:depth(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("depth")
}

declare function this:extent(
  $item as map(xs:string,item()*)
) as map(xs:string,item()*)
{
  $item("extent")
}

declare function this:id(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("id")
}

declare function this:num-points(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  array:size($node("points"))
}

declare function this:points(
  $node as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  array:flatten($node("points"))
}

declare function this:parent(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("parent")
}

declare function this:top-left(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("top-left")
}

declare function this:top-right(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("top-right")
}

declare function this:bottom-left(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("bottom-left")
}

declare function this:bottom-right(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("bottom-right")
}

declare function this:children(
  $node as map(xs:string,item()*)
) as xs:integer*
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  if ($node=>this:is-leaf()) then () else (
    $node("top-left"),
    $node("top-right"),
    $node("bottom-left"),
    $node("bottom-right")
  )
}

declare function this:parent(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  if ($node=>this:is-root()) then ()
  else $quadtree=>this:get-node($node("parent"))
}

declare function this:top-left(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  if ($node=>this:is-leaf()) then ()
  else $quadtree=>this:get-node($node("top-left"))
}

declare function this:top-right(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  if ($node=>this:is-leaf()) then ()
  else $quadtree=>this:get-node($node("top-right"))
}

declare function this:bottom-left(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  if ($node=>this:is-leaf()) then ()
  else $quadtree=>this:get-node($node("bottom-left"))
}

declare function this:bottom-right(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  if ($node=>this:is-leaf()) then ()
  else $quadtree=>this:get-node($node("bottom-right"))
}

declare function this:children(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  if ($node=>this:is-leaf()) then () else (
    $quadtree=>this:get-node($node("top-left")),
    $quadtree=>this:get-node($node("top-right")),
    $quadtree=>this:get-node($node("bottom-left")),
    $quadtree=>this:get-node($node("bottom-right"))
  )
}

declare function this:ancestors(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  util:while(
    function($nodes as map(xs:string,item()*)*) as xs:boolean {
      not($nodes[last()]=>this:is-root())
    },
    function($nodes as map(xs:string,item()*)*) as map(xs:string,item()*)* {
      $nodes,
      $quadtree=>this:get-node($nodes[last()]("parent"))
    },
    $node
  )=>tail()
}

declare function this:up-neighbour(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($node)="quadnode", "Must be quad node"),
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($node=>this:is-root()) then ()
  else (
    let $parent := $node=>this:parent($quadtree)
    let $quadrant := $node=>this:quadrant($parent)
    return (
      if ($quadrant = $this:BOTTOM-LEFT) then $parent=>this:top-left($quadtree)
      else if ($quadrant = $this:BOTTOM-RIGHT) then $parent=>this:top-right($quadtree)
      else (
        let $up := $parent=>this:up-neighbour($quadtree)
        return (
          if (empty($up) or $up=>this:is-leaf()) then $up
          else if ($quadrant = $this:TOP-LEFT) then $up=>this:bottom-left($quadtree)
          else (: quadrant = $this:TOP-RIGHT :) $up=>this:bottom-right($quadtree)
        )
      )
    )
  )
}

declare function this:down-neighbour(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($node)="quadnode", "Must be quad node"),
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($node=>this:is-root()) then ()
  else (
    let $parent := $node=>this:parent($quadtree)
    let $quadrant := $node=>this:quadrant($parent)
    return (
      if ($quadrant = $this:TOP-LEFT) then $parent=>this:bottom-left($quadtree)
      else if ($quadrant = $this:TOP-RIGHT) then $parent=>this:bottom-right($quadtree)
      else (
        let $down := $parent=>this:down-neighbour($quadtree)
        return (
          if (empty($down) or $down=>this:is-leaf()) then $down
          else if ($quadrant = $this:BOTTOM-LEFT) then $down=>this:top-left($quadtree)
          else (: quadrant = $this:BOTTOM-RIGHT :) $down=>this:top-right($quadtree)
        )
      )
    )
  )
}

declare function this:left-neighbour(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($node)="quadnode", "Must be quad node"),
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($node=>this:is-root()) then ()
  else (
    let $parent := $node=>this:parent($quadtree)
    let $quadrant := $node=>this:quadrant($parent)
    return (
      if ($quadrant = $this:TOP-RIGHT) then $parent=>this:top-left($quadtree)
      else if ($quadrant = $this:BOTTOM-RIGHT) then $parent=>this:bottom-left($quadtree)
      else (
        let $left := $parent=>this:left-neighbour($quadtree)
        return (
          if (empty($left) or $left=>this:is-leaf()) then $left
          else if ($quadrant = $this:TOP-LEFT) then $left=>this:top-right($quadtree)
          else (: quadrant = $this:BOTTOM-LEFT :) $left=>this:bottom-right($quadtree)
        )
      )
    )
  )
}

declare function this:right-neighbour(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($node)="quadnode", "Must be quad node"),
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($node=>this:is-root()) then ()
  else (
    let $parent := $node=>this:parent($quadtree)
    let $quadrant := $node=>this:quadrant($parent)
    return (
      if ($quadrant = $this:TOP-LEFT) then $parent=>this:top-right($quadtree)
      else if ($quadrant = $this:BOTTOM-LEFT) then $parent=>this:bottom-right($quadtree)
      else (
        let $right := $parent=>this:right-neighbour($quadtree)
        return (
          if (empty($right) or $right=>this:is-leaf()) then $right
          else if ($quadrant = $this:TOP-RIGHT) then $right=>this:top-left($quadtree)
          else (: quadrant = $this:BOTTOM-RIGHT :) $right=>this:bottom-left($quadtree)
        )
      )
    )
  )
}

declare function this:neighbours(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  if ($node=>this:is-root()) then () else (
    $node=>this:up-neighbour($quadtree),
    $node=>this:down-neighbour($quadtree),
    $node=>this:left-neighbour($quadtree),
    $node=>this:right-neighbour($quadtree)
  )
}

declare function this:insert(
  $quadtree as map(xs:string,item()*),
  $p as map(xs:string,item()*)
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if (not(point:valid($p)))
  then $quadtree
  else tail($quadtree=>this:insert(1, $p))
}

declare function this:insert-all(
  $quadtree as map(xs:string,item()*),
  $points as map(xs:string,item()*)*
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  fold-left($points, $quadtree,
    function($quadtree as map(xs:string,item()*), $p as map(xs:string,item()*)) as map(xs:string,item()*) {
      $quadtree=>this:insert($p)
    }
  )
}

declare function this:all-points(
  $quadtree as map(xs:string,item()*),
  $node as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  this:points($node),
  if (this:top-left($node)=0) then () else (
    $quadtree=>this:all-points($quadtree=>this:get-node(this:top-left($node))),
    $quadtree=>this:all-points($quadtree=>this:get-node(this:top-right($node))),
    $quadtree=>this:all-points($quadtree=>this:get-node(this:bottom-left($node))),
    $quadtree=>this:all-points($quadtree=>this:get-node(this:bottom-right($node)))
  )
}

declare function this:all-points(
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  $quadtree=>this:all-points($quadtree=>this:root())
}

declare function this:find-range(
  $quadtree as map(xs:string,item()*),
  $box as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>this:find-range(1, $box)
}

declare function this:nearest-point(
  $quadtree as map(xs:string,item()*),
  $point as map(xs:string,item()*),
  $radius as xs:double
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  this:find-nearest($quadtree, $point, $radius)("point")
}

declare function this:nearest-point(
  $quadtree as map(xs:string,item()*),
  $point as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>this:nearest-point($point, box:diagonal(this:extent($quadtree)) div 2)
}

declare function this:nearest-node(
  $quadtree as map(xs:string,item()*),
  $point as map(xs:string,item()*),
  $radius as xs:double
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  this:find-nearest($quadtree, $point, $radius)("node")
}

declare function this:nearest-node(
  $quadtree as map(xs:string,item()*),
  $point as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>this:nearest-node($point, box:diagonal(this:extent($quadtree)) div 2)
}

declare function this:visit(
  $quadtree as map(xs:string,item()*),
  $callback as function(map(xs:string,item()*), map(xs:string,item()*)) as item()*
) as item()*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>this:visit(1, $callback, false())
}

declare function this:visit(
  $quadtree as map(xs:string,item()*),
  $callback as function(map(xs:string,item()*), map(xs:string,item()*)) as item()*,
  $prune as xs:boolean
) as item()*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>this:visit(1, $callback, $prune)
}

Original Source Code

xquery version "3.1";
(:~
 : PR Quadtrees with default capacity of 4.
 :
 : Copyright© Mary Holstege 2021-2025
 : CC-BY (https://creativecommons.org/licenses/by/4.0/)
 : @since Mar 2024
 : @custom:Status New
 :)
module namespace this="http://mathling.com/geometric/tree/quadtree";

import module namespace errors="http://mathling.com/core/errors"
       at "../core/errors.xqy";
import module namespace util="http://mathling.com/core/utilities"
       at "../core/utilities.xqy";
import module namespace point="http://mathling.com/geometric/point"
       at "../geo/point.xqy";
import module namespace box="http://mathling.com/geometric/rectangle"
       at "../geo/rectangle.xqy";

declare namespace array="http://www.w3.org/2005/xpath-functions/array";
declare namespace map="http://www.w3.org/2005/xpath-functions/map";

(:~
 : Amount to add to lower right boundary so that points on initial boundary
 : count as in.
 :)
declare variable $this:ε as xs:double := 1E-6;

(:~
 : Default number of points each node contains before splitting.
 : Higher numbers means fewer levels in the tree; less precision in the location.
 :)
declare variable $this:DEFAULT-CAPACITY as xs:integer := 4;

(:~
 : Default range limit on the tree. A non-default extent can be set on an empty
 : tree or calculated as the actual extent of a set of points added to the tree.
 :)
declare variable $this:DEFAULT-EXTENT as map(xs:string,item()*) := box:box($point:ORIGIN, point:point(1600,1600));

(:~
 : Default minimum box size. Must be more than 3ε to avoid infinite
 : subdivision attempts.
 :)
declare variable $this:DEFAULT-MIN-EXTENT as xs:double := 3 * $this:ε;

(: Quadrant codes :)
declare %private variable $this:TOP-LEFT as xs:integer := 1;
declare %private variable $this:TOP-RIGHT as xs:integer := 2;
declare %private variable $this:BOTTOM-LEFT as xs:integer := 3;
declare %private variable $this:BOTTOM-RIGHT as xs:integer := 4;

(:~
 : quadtree()
 : Create an empty quadtree with default capacity and extent.
 : @return quadtree
 :)
declare function this:quadtree() as map(xs:string,item()*)
{
  map {
    "kind": "quadtree",
    "extent": $this:DEFAULT-EXTENT,
    "min-extent": $this:DEFAULT-MIN-EXTENT,
    "capacity": $this:DEFAULT-CAPACITY,
    "nodes": array { this:node(1, 0, 0, $this:DEFAULT-EXTENT) }
  }
};

(:~
 : quadtree()
 : Create a quadtree with default capacity containing the set of points.
 : The extent will be the actual extent of the set of points expanded on the
 : bottom right so that points on those bounds count as in.
 : Recommendation:
 : to attach data to the points, use a special key, such as "data".
 : @param $points: set of points.
 : @return quadtree
 :)
declare function this:quadtree(
  $points as map(xs:string,item()*)*
) as map(xs:string,item()*)
{
  let $extent := box:box(
    min($points!point:px(.)), min($points!point:py(.)),
    max($points!point:px(.)), max($points!point:py(.))
  )
  return (
    this:quadtree()=>
      this:set-extent($extent)=>
      this:insert-all($points)
  )
};

(:~
 : quadtree()
 : Create a quadtree with default capacity containing the set of points. Only
 : points within the extent will be added.
 : @param $points: set of points
 : @param $extent: extent of tree
 : @return quadtree
 :)
declare function this:quadtree(
  $points as map(xs:string,item()*)*,
  $extent as map(xs:string,item()*)
) as map(xs:string,item()*)
{
  this:quadtree()=>
    this:set-extent($extent)=>
    this:insert-all($points)
};

(:~
 : set-minimum-extent()
 : Set a minimum size for the extents of the nodes in the tree. Existing nodes
 : will not be recalculated.
 : @param $quadtree: the quadtree
 : @param $minimum-extent: new node minimum-extent
 : @return updated quadtree
 :)
declare function this:set-minimum-extent(
  $quadtree as map(xs:string,item()*),
  $minimum-extent as xs:double
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($minimum-extent < 3*$this:ε) then errors:error("GEOM-BAD-EXTENT", ($minimum-extent, 3*$this:ε)) else (),
  $quadtree=>map:put("min-extent", $minimum-extent)
};

(:~
 : set-capacity()
 : Set a capacity for the nodes in the tree. It is inadvisable to change the
 : capacity on a tree that already has points in it: the nodes will not be
 : recalculated with the new capacity.
 : @param $quadtree: the quadtree
 : @param $capacity: new node capacity
 : @return updated quadtree
 :)
declare function this:set-capacity(
  $quadtree as map(xs:string,item()*),
  $capacity as xs:integer
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>map:put("capacity", $capacity)
};

(:~
 : set-extent()
 : Set an extent for tree. It is an error to change the extent of a tree that
 : already has points in it. The extent have ε added to it on the bottom and
 : right bounds so that points on those bounds will count as in.
 : @param $quadtree: the quadtree
 : @param $extent: extent of tree
 : @return updated quadtree
 :)
declare function this:set-extent(
  $quadtree as map(xs:string,item()*),
  $extent as map(xs:string,item()*)
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if (this:num-nodes($quadtree) !=1 or this:size($quadtree)!=0)
  then errors:error("GEOM-API-MISUSE", ("set-extent", "quadtree with points"))
  else if (not(point:valid(box:min-point($extent))) or not(point:valid(box:max-point($extent))))
  then errors:error("GEOM-BADREGION", ($extent, "quad:set-extent"))
  else (
    let $extent := box:box(box:min-point($extent), box:max-point($extent)=>point:add(point:point($this:ε, $this:ε)))
    return (
      $quadtree=>
        map:put("extent", $extent)=>
        this:put-node(1, this:get-node($quadtree, 1)=>map:put("extent", $extent))
    )
  )
};

(:~
 : size()
 : Get the number of points in the tree.
 : @param $quadtree: the quadtree
 : @return number of points
 :)
declare function this:size(
  $quadtree as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  count(this:all-points($quadtree))
};

(:~
 : num-nodes()
 : Get the number of nodes in the tree.
 : @param $quadtree: the quadtree
 : @return node count, including root
 :)
declare function this:num-nodes(
  $quadtree as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree("nodes")=>array:size()
};

(:~
 : nodes()
 : Get all the nodes in the tree, no particular order. visit() can run
 : afoul of stack overflows; but if you don't care about the preorder
 : walk, this is simpler.
 : @param $quadtree: the quadtree
 : @return nodes
 :)
declare function this:nodes(
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree("nodes")=>array:flatten()
};

(:~
 : root()
 : Get the root nodes of the tree.
 : @param $quadtree: the quadtree
 : @return root node
 :)
declare function this:root(
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>this:get-node(1)
};

(:~
 : next-id()
 : Get the next ID to use for nodes.
 : @param $quadtree: the quadtree
 : @return available node ID
 :)
declare %private function this:next-id(
  $quadtree as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree("nodes")=>array:size() + 1
};

(:~
 : get-node()
 : Look up the given node ID in the tree and return it. Node ID 0 always returns
 : the empty sequence; other out of range IDs will raise an error.
 : @param $quadtree: the quadtree
 : @return the node, if it exists
 :)
declare function this:get-node(
  $quadtree as map(xs:string,item()*),
  $id as xs:integer
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($id = 0) then () else $quadtree("nodes")($id)
};

(:~
 : minimum-extent()
 : Accessor for minimum node extent in the tree.
 : @param $quadtree: the quadtree
 : @return the minimum extent on the nodes
 :)
declare function this:minimum-extent(
  $quadtree as map(xs:string,item()*)
) as xs:double
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree("min-extent")
};

(:~
 : capacity()
 : Accessor for node capacity in the tree.
 : @param $quadtree: the quadtree
 : @return the capacity limit on the nodes
 :)
declare function this:capacity(
  $quadtree as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree("capacity")
};

(:~
 : put-node()
 : Add a node into the tree. The ID should be an existing ID in range or the next
 : available ID.
 : @param $quadtree: the quadtree
 : @param $id: ID of the node
 : @param $node: node to add
 : @return the updated tree
 :)
declare %private function this:put-node(
  $quadtree as map(xs:string,item()*),
  $id as xs:integer,
  $node as map(xs:string,item()*)
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  util:assert(util:twixt($id, 1, array:size($quadtree("nodes")) + 1), "Node ID out of bounds "||$id),
  util:assert($id = $node("id"), "Node ID mismatch "||$id||"!="||$node("id")),
  $quadtree=>map:put("nodes",
    if ($id = array:size($quadtree("nodes")) + 1)
    then $quadtree("nodes")=>array:append($node)
    else $quadtree("nodes")=>array:put($id, $node)
  )
};

(:~
 : quote()
 : Quote the quadtree or quad nodes, for debugging. Data will be rounded to 1
 : decimal point.
 : @param $items: sequence of nodes or quadtrees
 : @return debugging string
 :)
declare function this:quote(
  $items as map(xs:string,item()*)*
) as xs:string
{
  string-join(
    for $item in $items return (
      if (util:kind($item)="quadtree") then (
        "quad:"||$item("capacity")||"["||box:quote(box:decimal($item("extent"),1))||"
  "||
           string-join(this:quote(array:flatten($item("nodes"))),"
    ")||
        "]"
      ) else ( (: node :)
        "node-"||$item("id")||"["||box:quote(box:decimal($item("extent"),1))||" ("||
          $item("top-left")||","||$item("top-right")||","||$item("bottom-left")||","||$item("bottom-right")||
        ") ("||
          point:quote(point:decimal(array:flatten($item("points")),1))||
        ")"||
        "]"
      )
    ),
    " "
  )
};

(:~
 : node()
 : Construct a tree node.
 : @param $id: ID of the node
 : @param $extent: extent of the node
 : @param $points: points in the node, an array
 : @param $parent: ID of parent node
 : @param $depth: depth in tree
 : @param $top-left: ID of top-left child
 : @param $top-right: ID of top-right child
 : @param $bottom-left: ID of bottom-left child
 : @param $bottom-left: ID of bottom-left child
 : @return the new node
 :)
declare %private function this:node(
  $id as xs:integer,
  $extent as map(xs:string,item()*),
  $points as array(map(xs:string,item()*)),
  $parent as xs:integer,
  $depth as xs:integer,
  $top-left as xs:integer,
  $top-right as xs:integer,
  $bottom-left as xs:integer,
  $bottom-right as xs:integer
) as map(xs:string,item()*)
{
  map {
    "kind": "quadnode",
    "id": $id,
    "parent": $parent,
    "depth": $depth,
    "extent": $extent,
    "points": $points,
    "top-left": $top-left,
    "top-right": $top-right,
    "bottom-left": $bottom-left,
    "bottom-right": $bottom-right
  }
};

(:~
 : node()
 : Construct a tree node with no points or children.
 : @param $id: ID of the node
 : @param $parent: ID of the parent node
 : @param $depth: depth in tree
 : @param $extent: extent of the node
 : @return the new node
 :)
declare %private function this:node(
  $id as xs:integer,
  $parent as xs:integer,
  $depth as xs:integer,
  $extent as map(xs:string,item()*)
) as map(xs:string,item()*)
{
  this:node($id, $extent, array {}, $parent, $depth, 0, 0, 0, 0)
};

(:~
 : is-leaf()
 : Does this node have child nodes?
 : @param $node: tree or tree node
 : @return true if there are no child nodes
 :)
declare function this:is-leaf(
  $node as map(xs:string,item()*)
) as xs:boolean
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  this:top-left($node) = 0
};

(:~
 : is-root()
 : Is this the root node?
 : @param $node: tree or tree node
 : @return true if this is the root node
 :)
declare function this:is-root(
  $node as map(xs:string,item()*)
) as xs:boolean
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  this:id($node) = 1
};

(:~
 : depth()
 : Accessor for node depth.
 : @param $node: tree node
 : @return extent of the tree or node
 :)
declare function this:depth(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("depth")
};

(:~
 : extent()
 : Accessor for node or tree extent.
 : @param $item: tree or tree node
 : @return extent of the tree or node
 :)
declare function this:extent(
  $item as map(xs:string,item()*)
) as map(xs:string,item()*)
{
  $item("extent")
};

(:~
 : id()
 : Accessor for node ID.
 : @param $node: tree or tree node
 : @return ID of node
 :)
declare function this:id(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("id")
};

(:~
 : num-points()
 : Accessor for number of points in the node, not including children.
 : @param $node: tree node
 : @return count of number of points in the node
 :)
declare function this:num-points(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  array:size($node("points"))
};

(:~
 : points()
 : Accessor for points in the node, not including children.
 : @param $node: tree node
 : @return points in the node
 :)
declare function this:points(
  $node as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  array:flatten($node("points"))
};

(:~
 : parent()
 : Accessor for ID of parent child of node.
 : @param $node: tree node
 : @return node ID
 :)
declare function this:parent(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("parent")
};

(:~
 : top-left()
 : Accessor for ID of top-left child of node.
 : @param $node: tree node
 : @return node ID
 :)
declare function this:top-left(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("top-left")
};

(:~
 : top-right()
 : Accessor for ID of top-right child of node.
 : @param $node: tree node
 : @return node ID
 :)
declare function this:top-right(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("top-right")
};

(:~
 : bottom-left()
 : Accessor for ID of bottom-left child of node.
 : @param $node: tree node
 : @return node ID
 :)
declare function this:bottom-left(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("bottom-left")
};

(:~
 : bottom-right()
 : Accessor for ID of bottom-right child of node.
 : @param $node: tree node
 : @return node ID
 :)
declare function this:bottom-right(
  $node as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node("bottom-right")
};

(:~
 : children()
 : Accessor for IDs all children of node in the order top-left, top-right,
 : bottom-left, bottom-right.
 : @param $node: tree node
 : @return node IDs
 :)
declare function this:children(
  $node as map(xs:string,item()*)
) as xs:integer*
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  if ($node=>this:is-leaf()) then () else (
    $node("top-left"),
    $node("top-right"),
    $node("bottom-left"),
    $node("bottom-right")
  )
};

(:~
 : parent()
 : Accessor for parent child of node.
 : @param $node: tree node
 : @param $quadtree: tree
 : @return node
 :)
declare function this:parent(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  if ($node=>this:is-root()) then ()
  else $quadtree=>this:get-node($node("parent"))
};

(:~
 : top-left()
 : Accessor for top-left child of node.
 : @param $node: tree node
 : @param $quadtree: tree
 : @return node
 :)
declare function this:top-left(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  if ($node=>this:is-leaf()) then ()
  else $quadtree=>this:get-node($node("top-left"))
};

(:~
 : top-right()
 : Accessor for top-right child of node.
 : @param $node: tree node
 : @param $quadtree: tree
 : @return node
 :)
declare function this:top-right(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  if ($node=>this:is-leaf()) then ()
  else $quadtree=>this:get-node($node("top-right"))
};


(:~
 : bottom-left()
 : Accessor for bottom-left child of node.
 : @param $node: tree node
 : @param $quadtree: tree
 : @return node
 :)
declare function this:bottom-left(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  if ($node=>this:is-leaf()) then ()
  else $quadtree=>this:get-node($node("bottom-left"))
};

(:~
 : bottom-right()
 : Accessor for bottom-right child of node.
 : @param $node: tree node
 : @param $quadtree: tree
 : @return node
 :)
declare function this:bottom-right(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  if ($node=>this:is-leaf()) then ()
  else $quadtree=>this:get-node($node("bottom-right"))
};

(:~
 : childen()
 : Accessor for all children of node.
 : @param $quadtree: tree
 : @param $node: tree node
 : @return nodes
 :)
declare function this:children(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  if ($node=>this:is-leaf()) then () else (
    $quadtree=>this:get-node($node("top-left")),
    $quadtree=>this:get-node($node("top-right")),
    $quadtree=>this:get-node($node("bottom-left")),
    $quadtree=>this:get-node($node("bottom-right"))
  )
};

(:~
 : set-children()
 : Set the node IDs for the children of the node
 : @param $node: tree node
 : @param $top-left: ID of top-left child
 : @param $top-right: ID of top-right child
 : @param $bottom-left: ID of bottom-left child
 : @param $bottom-left: ID of bottom-left child
 : @return updated node
 :)
declare %private function this:set-children(
  $node as map(xs:string,item()*),
  $top-left as xs:integer,
  $top-right as xs:integer,
  $bottom-left as xs:integer,
  $bottom-right as xs:integer
) as map(xs:string,item()*)
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  $node=>util:merge-into(
    map {
      "top-left": $top-left,
      "top-right": $top-right,
      "bottom-left": $bottom-left,
      "bottom-right": $bottom-right
    }
  )
};

(:~
 : ancestors()
 : Get all the ancestors of the given node up from the parent up to the root in
 : order. Excludes current node.
 : @param $quadtree: tree
 : @param $node: tree node
 : @return nodes
 :)
declare function this:ancestors(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be tree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  util:while(
    function($nodes as map(xs:string,item()*)*) as xs:boolean {
      not($nodes[last()]=>this:is-root())
    },
    function($nodes as map(xs:string,item()*)*) as map(xs:string,item()*)* {
      $nodes,
      $quadtree=>this:get-node($nodes[last()]("parent"))
    },
    $node
  )=>tail()
};

(:~
 : quadrant()
 : Which quadrant is this node of the parent?
 : @param $node: the node
 : @param $parent: its parent node
 : @return quadrant number
 :)
declare %private function this:quadrant(
  $node as map(xs:string,item()*),
  $parent as map(xs:string,item()*)
) as xs:integer
{
  util:assert(util:kind($node)="quadnode", "Must be quad node"),
  util:assert(util:kind($parent)="quadnode", "Must be quad node"),
  util:assert($node=>this:parent()=$parent=>this:id(), "Must be child of parent"),
  let $id := $node=>this:id()
  return (
    if ($id = $parent=>this:top-left()) then $this:TOP-LEFT
    else if ($id = $parent=>this:top-right()) then $this:TOP-RIGHT
    else if ($id = $parent=>this:bottom-left()) then $this:BOTTOM-LEFT
    else (: $id = $parent=>this:bottom-right() :) $this:BOTTOM-RIGHT
  )
};

(:~
 : up-neighbour()
 : Node upwards current node, if any.
 :
 : @param $node: the node
 : @param $quadtree: the tree
 : @return the neighbour, if any
 :)
declare function this:up-neighbour(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($node)="quadnode", "Must be quad node"),
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($node=>this:is-root()) then ()
  else (
    let $parent := $node=>this:parent($quadtree)
    let $quadrant := $node=>this:quadrant($parent)
    return (
      if ($quadrant = $this:BOTTOM-LEFT) then $parent=>this:top-left($quadtree)
      else if ($quadrant = $this:BOTTOM-RIGHT) then $parent=>this:top-right($quadtree)
      else (
        let $up := $parent=>this:up-neighbour($quadtree)
        return (
          if (empty($up) or $up=>this:is-leaf()) then $up
          else if ($quadrant = $this:TOP-LEFT) then $up=>this:bottom-left($quadtree)
          else (: quadrant = $this:TOP-RIGHT :) $up=>this:bottom-right($quadtree)
        )
      )
    )
  )
};

(:~
 : down-neighbour()
 : Node downwards current node, if any.
 :
 : @param $node: the node
 : @param $quadtree: the tree
 : @return the neighbour, if any
 :)
declare function this:down-neighbour(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($node)="quadnode", "Must be quad node"),
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($node=>this:is-root()) then ()
  else (
    let $parent := $node=>this:parent($quadtree)
    let $quadrant := $node=>this:quadrant($parent)
    return (
      if ($quadrant = $this:TOP-LEFT) then $parent=>this:bottom-left($quadtree)
      else if ($quadrant = $this:TOP-RIGHT) then $parent=>this:bottom-right($quadtree)
      else (
        let $down := $parent=>this:down-neighbour($quadtree)
        return (
          if (empty($down) or $down=>this:is-leaf()) then $down
          else if ($quadrant = $this:BOTTOM-LEFT) then $down=>this:top-left($quadtree)
          else (: quadrant = $this:BOTTOM-RIGHT :) $down=>this:top-right($quadtree)
        )
      )
    )
  )
};

(:~
 : left-neighbour()
 : Node leftwards current node, if any.
 :
 : @param $node: the node
 : @param $quadtree: the tree
 : @return the neighbour, if any
 :)
declare function this:left-neighbour(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($node)="quadnode", "Must be quad node"),
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($node=>this:is-root()) then ()
  else (
    let $parent := $node=>this:parent($quadtree)
    let $quadrant := $node=>this:quadrant($parent)
    return (
      if ($quadrant = $this:TOP-RIGHT) then $parent=>this:top-left($quadtree)
      else if ($quadrant = $this:BOTTOM-RIGHT) then $parent=>this:bottom-left($quadtree)
      else (
        let $left := $parent=>this:left-neighbour($quadtree)
        return (
          if (empty($left) or $left=>this:is-leaf()) then $left
          else if ($quadrant = $this:TOP-LEFT) then $left=>this:top-right($quadtree)
          else (: quadrant = $this:BOTTOM-LEFT :) $left=>this:bottom-right($quadtree)
        )
      )
    )
  )
};

(:~
 : right-neighbour()
 : Node rightwards current node, if any.
 :
 : @param $node: the node
 : @param $quadtree: the tree
 : @return the neighbour, if any
 :)
declare function this:right-neighbour(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($node)="quadnode", "Must be quad node"),
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($node=>this:is-root()) then ()
  else (
    let $parent := $node=>this:parent($quadtree)
    let $quadrant := $node=>this:quadrant($parent)
    return (
      if ($quadrant = $this:TOP-LEFT) then $parent=>this:top-right($quadtree)
      else if ($quadrant = $this:BOTTOM-LEFT) then $parent=>this:bottom-right($quadtree)
      else (
        let $right := $parent=>this:right-neighbour($quadtree)
        return (
          if (empty($right) or $right=>this:is-leaf()) then $right
          else if ($quadrant = $this:TOP-RIGHT) then $right=>this:top-left($quadtree)
          else (: quadrant = $this:BOTTOM-RIGHT :) $right=>this:bottom-left($quadtree)
        )
      )
    )
  )
};

(:~
 : neighbours()
 : Nodes upwards, downwards, leftwards, rightwards of current node, if any.
 :
 : @param $node: the node
 : @param $quadtree: the tree
 : @return the neighbours
 :)
declare function this:neighbours(
  $node as map(xs:string,item()*),
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  if ($node=>this:is-root()) then () else (
    $node=>this:up-neighbour($quadtree),
    $node=>this:down-neighbour($quadtree),
    $node=>this:left-neighbour($quadtree),
    $node=>this:right-neighbour($quadtree)
  )
};

(:~
 : add-points()
 : Add points to the node.
 : @param $node: tree node
 : @param $points: points to add
 : @return updated node
 :)
declare %private function this:add-points(
  $node as map(xs:string,item()*),
  $points as map(xs:string,item()*)*
) as map(xs:string,item()*)
{
  util:assert(util:kind($node)="quadnode", "Must be node"),
  fold-left($points, $node,
    function($node as map(xs:string,item()*), $point as map(xs:string,item()*)) as map(xs:string,item()*) {
      $node=>map:put("points", array:append($node("points"), $point))
    }
  )
};


(:~
 : split()
 : Split the node, creating the child nodes, redistributing points to the children.
 : @param $quadtree: the tree
 : @param $id: ID of node to split
 : @return updated tree
 :)
declare %private function this:split(
  $quadtree as map(xs:string,item()*),
  $id as xs:integer
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  let $node := $quadtree=>this:get-node($id)
  let $depth := $node=>this:depth()
  let $extent := this:extent($node)
  let $center := box:center($extent)
  let $cx := point:px($center)
  let $cy := point:py($center)
  let $top-left := $quadtree=>this:next-id()
  let $top-right := $top-left + 1
  let $bottom-left := $top-right + 1
  let $bottom-right := $bottom-left + 1
  let $top-left-box := box:box(box:min-point($extent), $center)
  let $top-right-box := box:box(point:point($cx, box:min-py($extent)), point:point(box:max-px($extent), $cy))
  let $bottom-left-box := box:box(point:point(box:min-px($extent), $cy), point:point($cx, box:max-py($extent)))
  let $bottom-right-box := box:box($center, box:max-point($extent))
  let $points := this:points($node)
  return (
    $quadtree=>this:put-node($id,
      $node=>
        this:set-children($top-left, $top-right, $bottom-left, $bottom-right)=>
        map:put("points", array {})
    )=>this:put-node($top-left,
      this:node($top-left, $id, $depth + 1, $top-left-box)=>
        this:add-points($points[this:contains($top-left-box, .)])
    )=>this:put-node($top-right,
      this:node($top-right, $id, $depth + 1, $top-right-box)=>
        this:add-points($points[this:contains($top-right-box, .)])
    )=>this:put-node($bottom-left,
      this:node($bottom-left, $id, $depth + 1, $bottom-left-box)=>
        this:add-points($points[this:contains($bottom-left-box, .)])
    )=>this:put-node($bottom-right,
      this:node($bottom-right, $id, $depth + 1, $bottom-right-box)=>
        this:add-points($points[this:contains($bottom-right-box, .)])
    )
  )
};

(:~
 : insert()
 : Insert a point into the tree.
 : @param $quadtree: the tree
 : @param $p: point to add
 : @return updated tree
 :)
declare function this:insert(
  $quadtree as map(xs:string,item()*),
  $p as map(xs:string,item()*)
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if (not(point:valid($p)))
  then $quadtree
  else tail($quadtree=>this:insert(1, $p))
};

(:~
 : contains()
 : The box contains the point, but not on the bottom right edge.
 : @param $box: the box, with closed upper and left bounds, open lower and right ones
 : @param $point: point to test
 : @return true iff the point is within the box
 :)
declare %private function this:contains(
  $box as map(xs:string,item()*),
  $point as map(xs:string,item()*)
) as xs:boolean
{
  point:px($point) >= box:min-px($box) and
  point:px($point) < box:max-px($box) and
  point:py($point) >= box:min-py($box) and
  point:py($point) < box:max-py($box)
};

(:~
 : insert()
 : Insert a point into the subtree from the given node down.
 : @param $quadtree: the tree
 : @param $id: id of current node
 : @param $p: point to add
 : @return success flag + updated tree
 :)
declare %private function this:insert(
  $quadtree as map(xs:string,item()*),
  $id as xs:integer,
  $p as map(xs:string,item()*)
) as item()* (: success flag + new tree :)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  if ($id = 0) then (false(), $quadtree) else (: Can't put point in null node :)
  let $node := $quadtree=>this:get-node($id)
  return
  if (not(this:extent($node)=>this:contains($p))) then (
  (: If it isn't in the space of the current node, don't add it, return false :)
    false(),
    $quadtree
  ) else if (
  (: If there is space in this node and no subdivisions; add here :)
  (: Or if this node's extent is the minimum :)
    (this:num-points($node) < this:capacity($quadtree) and this:is-leaf($node))
    or
    (box:width(this:extent($node)) div 2 <= this:minimum-extent($quadtree))
  ) then (
    true(),
    $quadtree=>this:put-node($id, $node=>this:add-points($p))
  ) else (
  (: Split and add point to whichever node takes it :)
    let $quadtree := (
      if (this:is-leaf($node))
      then $quadtree=>this:split($id)
      else $quadtree
    )
    (: Refetch updated node :)
    let $node := $quadtree=>this:get-node($id)
    (: Try to find a child node to add the point to :)
    return (
      fold-left(
        $node=>this:children(), (false(), $quadtree),
        function($data as item()*, $child as xs:integer) as item()* {
          if (head($data)) then $data else (
            tail($data)=>this:insert($child, $p)
          )
        }
      )
    )
  )
};

(:~
 : insert-all()
 : Insert all points into the quadtree
 : @param $quadtree: the tree
 : @param $points: points to add
 : @return success flag + updated tree
 :)
declare function this:insert-all(
  $quadtree as map(xs:string,item()*),
  $points as map(xs:string,item()*)*
) as map(xs:string,item()*)
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  fold-left($points, $quadtree,
    function($quadtree as map(xs:string,item()*), $p as map(xs:string,item()*)) as map(xs:string,item()*) {
      $quadtree=>this:insert($p)
    }
  )
};

(:~
 : all-points()
 : Get all the points in the quadtree under the node, including children.
 : @param $node: tree node
 : @return points in the node or its descendants
 :)
declare function this:all-points(
  $quadtree as map(xs:string,item()*),
  $node as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  util:assert(util:kind($node)="quadnode", "Must be node"),
  this:points($node),
  if (this:top-left($node)=0) then () else (
    $quadtree=>this:all-points($quadtree=>this:get-node(this:top-left($node))),
    $quadtree=>this:all-points($quadtree=>this:get-node(this:top-right($node))),
    $quadtree=>this:all-points($quadtree=>this:get-node(this:bottom-left($node))),
    $quadtree=>this:all-points($quadtree=>this:get-node(this:bottom-right($node)))
  )
};

(:~
 : all-points()
 : Get all the points in the quadtree, including children.
 : @param $node: tree node
 : @return points in the tree
 :)
declare function this:all-points(
  $quadtree as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  $quadtree=>this:all-points($quadtree=>this:root())
};

(:~
 : find-range()
 : Find all points within a particular extent within the quadtree.
 : @param $quadtree: the tree
 : @param $box: search extent
 : @return sequence of points
 :)
declare function this:find-range(
  $quadtree as map(xs:string,item()*),
  $box as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>this:find-range(1, $box)
};

(:~
 : find-range()
 : Find all points within a particular extent under the current node.
 : @param $quadtree: the tree
 : @param $id: current node id
 : @param $box: search extent
 : @return sequence of points
 :)
declare %private function this:find-range(
  $quadtree as map(xs:string,item()*),
  $id as xs:integer,
  $box as map(xs:string,item()*)
) as map(xs:string,item()*)*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  let $node := $quadtree=>this:get-node($id)
  return (
    (: If no boundary intersection or null node, return nothing :)
    if (empty($node) or not(box:intersects-box(this:extent($node), $box)))
    then ()
    else (
      (: Points at this level :)
      this:points($node)[box:contains-point($box, .)],
      (: Points from children, if any :)
      if (this:is-leaf($node)) then () else (
        $quadtree=>this:find-range(this:top-left($node), $box),
        $quadtree=>this:find-range(this:top-right($node), $box),
        $quadtree=>this:find-range(this:bottom-left($node), $box),
        $quadtree=>this:find-range(this:bottom-right($node), $box)
      )
    )
  )
};

(:~
 : find-nearest()
 : Find the nearest point to the given point within the given radius, if any.
 :
 : @param $quadtree: the tree
 : @param $point: the probe point
 : @param $radius: search radius: only points this close to probe point matter
 : @return the search result a map with the keys "point", "distance", and "node"
 :)
declare %private function this:find-nearest(
  $quadtree as map(xs:string,item()*),
  $point as map(xs:string,item()*),
  $radius as xs:double
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  let $radius := (
    if ($radius=xs:double("INF"))
    then box:diagonal(this:extent($quadtree)) div 2
    else $radius
  )
  let $node := $quadtree=>this:get-node(1)
  let $delta := point:point($radius, $radius)
  let $extent := box:box($point=>point:sub($delta), $point=>point:add($delta))
  return (
    util:while(
      function(
        $queue as array(*),
        $extent as map(xs:string,item()*),
        $current as map(xs:string,item()*)
      ) as xs:boolean {
        array:size($queue) > 0
      },
      function(
        $queue as array(*),
        $extent as map(xs:string,item()*),
        $current as map(xs:string,item()*)
      ) as item()* {
        let $pair := $queue(array:size($queue))
        let $queue := $queue=>array:remove(array:size($queue))
        let $node := $quadtree=>this:get-node($pair(1))
        let $box-extent := $pair(2)
        return (
          if (empty($node) or not(box:intersects-box($box-extent, $extent)))
          then (
            $queue, $extent, $current
          ) else (
            (: Visit points at this level :)
            let $distance := $current("distance")
            let $result := $current("result")
            let $points := this:points($node)
            let $n-points := this:num-points($node)
            let $distances := $points!point:distance(., $point)
            let $bestix := sort(1 to $n-points + 1, (),
              function($i as xs:integer) as xs:double {
                ($distances, $distance)[$i]
              }
            )=>head()
            let $candidate-distance := if ($bestix > $n-points) then $distance else $distances[$bestix]
            let $distance := if ($candidate-distance <= $radius) then $candidate-distance else $distance
            let $result := (
              if ($bestix > $n-points or $candidate-distance > $radius)
              then $result
              else $points[$bestix]
            )
            let $result-node := (
              if ($bestix > $n-points or $candidate-distance > $radius)
              then $current("node")
              else $node
            )
            let $extent := (
              if ($bestix > $n-points or $candidate-distance > $radius)
              then $extent
              else (
                let $delta := point:point($distance, $distance)
                return box:box($point=>point:sub($delta), $point=>point:add($delta))
              )
            )
            return (
              if (not(this:is-leaf($node))) then (
                let $box-extent := this:extent($node)
                let $center := box:center($box-extent)
                let $cx := point:px($center)
                let $cy := point:py($center)
                let $quadrants := (
                  array {this:top-left($node), box:box(box:min-point($extent), $center)},
                  array {this:top-right($node), box:box(point:point($cx, box:min-py($box-extent)), point:point(box:max-px($box-extent), $cy))},
                  array {this:bottom-left($node), box:box(point:point(box:min-px($box-extent), $cy), point:point($cx, box:max-py($box-extent)))},
                  array {this:bottom-right($node), box:box($center, box:max-point($box-extent))}
                )
                let $nearest-quadrant := (if (point:py($point) < $cy) then 1 else 3)
                let $nearest-quadrant := (if (point:px($point) < $cx) then $nearest-quadrant else $nearest-quadrant + 1)
                let $quadrants := (
                  reverse($quadrants[not(position()=$nearest-quadrant)]),
                  $quadrants[position()=$nearest-quadrant]
                )
                let $queue := (
                  fold-left($quadrants, $queue,
                    function($queue as array(*), $quadrant as array(*)) as array(*) {
                      $queue=>array:append($quadrant)
                    }
                  )
                )
                return (
                  $queue, $extent, map {"distance": $distance, "point": $result, "node": $result-node}
                )
              ) else (
                $queue, $extent, map {"distance": $distance, "point": $result, "node": $result-node}
              )
            )
          )
        )
      },
      array { [1, $extent] },
      $extent,
      map {"distance": xs:double("INF")}
    )
  )[3] (: Result structure :)
};

(:~
 : nearest-point()
 : Find the nearest point to the given point within the given radius, if any.
 :
 : @param $quadtree: the tree
 : @param $point: the probe point
 : @param $radius: search radius: only points this close to probe point matter
 : @return nearest point
 :)
declare function this:nearest-point(
  $quadtree as map(xs:string,item()*),
  $point as map(xs:string,item()*),
  $radius as xs:double
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  this:find-nearest($quadtree, $point, $radius)("point")
};

(:~
 : nearest-point()
 : Find the nearest point to the given point with the radius of the tree.
 :
 : @param $quadtree: the tree
 : @param $point: the probe point
 : @return nearest point
 :)
declare function this:nearest-point(
  $quadtree as map(xs:string,item()*),
  $point as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>this:nearest-point($point, box:diagonal(this:extent($quadtree)) div 2)
};

(:~
 : nearest-node()
 : Find the node containing the nearest point in tree to the given point within the
 : given radius, if any.
 :
 : @param $quadtree: the tree
 : @param $point: the probe point
 : @param $radius: search radius: only points this close to probe point matter
 : @return node containing nearest point
 :)
declare function this:nearest-node(
  $quadtree as map(xs:string,item()*),
  $point as map(xs:string,item()*),
  $radius as xs:double
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  this:find-nearest($quadtree, $point, $radius)("node")
};

(:~
 : nearest-node()
 : Find the node containing the nearest point in tree to the given point.
 :
 : @param $quadtree: the tree
 : @param $point: the probe point
 : @return node containing nearest point
 :)
declare function this:nearest-node(
  $quadtree as map(xs:string,item()*),
  $point as map(xs:string,item()*)
) as map(xs:string,item()*)?
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>this:nearest-node($point, box:diagonal(this:extent($quadtree)) div 2)
};

(:~
 : visit()
 : Visit every node in the tree with a particular callback function.
 : @param $quadtree: the tree
 : @param $callback: callback function that takes quadtree and node as parameters
 : @return sequence of results from callback function
 :)
declare function this:visit(
  $quadtree as map(xs:string,item()*),
  $callback as function(map(xs:string,item()*), map(xs:string,item()*)) as item()*
) as item()*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>this:visit(1, $callback, false())
};

(:~
 : visit()
 : Visit every node in the tree with a particular callback function.
 : If pruning is enabled, only visit the children if the parent returned the
 : empty sequence. Otherwise all nodes are visited.
 : @param $quadtree: the tree
 : @param $callback: callback function that takes quadtree and node as parameters
 : @param $prune: whether to visit children if parent returned value
 : @return sequence of results from callback function
 :)
declare function this:visit(
  $quadtree as map(xs:string,item()*),
  $callback as function(map(xs:string,item()*), map(xs:string,item()*)) as item()*,
  $prune as xs:boolean
) as item()*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  $quadtree=>this:visit(1, $callback, $prune)
};

(:~
 : visit()
 : Visit every node in the tree under then current node with a particular
 : callback function. If pruning is enabled, only visit the children if the
 : parent returned the empty sequence. Otherwise all nodes are visited.
 : @param $quadtree: the tree
 : @param $id: current node id
 : @param $callback: callback function that takes quadtree and node as parameters
 : @param $prune: whether to visit children if parent returned value
 : @return sequence of results from callback function
 :)
declare %private function this:visit(
  $quadtree as map(xs:string,item()*),
  $id as xs:integer,
  $callback as function(map(xs:string,item()*), map(xs:string,item()*)) as item()*,
  $prune as xs:boolean
) as item()*
{
  util:assert(util:kind($quadtree)="quadtree", "Must be quadtree"),
  let $node := $quadtree=>this:get-node($id)
  return (
    if (empty($node)) then () else (
      let $parent-value := $quadtree=>$callback($node)
      return (
        $parent-value,
        if (not($prune) or empty($parent-value)) then (
          $quadtree=>this:visit(this:top-left($node), $callback, $prune),
          $quadtree=>this:visit(this:top-right($node), $callback, $prune),
          $quadtree=>this:visit(this:bottom-left($node), $callback, $prune),
          $quadtree=>this:visit(this:bottom-right($node), $callback, $prune)
        ) else (
        )
      )
    )
  )
};