Fatal编程技术网

Wolfram mathematica 在Mathematica中实现四叉树

wolfram-mathematica

Wolfram mathematica 在Mathematica中实现四叉树,wolfram-mathematica,quadtree,Wolfram Mathematica,Quadtree,我在Mathematica中实现了一个。我对使用Mathematica这样的函数式编程语言进行编码还不熟悉，我想知道是否可以通过更好地使用模式来改进这一点或使其更加紧凑 （我知道我可能可以通过修剪未使用的节点来优化树，并且可能有更好的数据结构，如用于空间分解的k-d树。） 而且，每次添加新点时复制整个树/表达式的想法仍然让我感到不舒服。但我的理解是，函数式编程方式是将表达式作为一个整体进行操作，而不是修改部分。如果您能在这方面作出澄清，我将不胜感激 MV 代码 ClearAll[qtMakeNo

我在Mathematica中实现了一个。我对使用Mathematica这样的函数式编程语言进行编码还不熟悉，我想知道是否可以通过更好地使用模式来改进这一点或使其更加紧凑

（我知道我可能可以通过修剪未使用的节点来优化树，并且可能有更好的数据结构，如用于空间分解的k-d树。）

而且，每次添加新点时复制整个树/表达式的想法仍然让我感到不舒服。但我的理解是，函数式编程方式是将表达式作为一个整体进行操作，而不是修改部分。如果您能在这方面作出澄清，我将不胜感激

MV

代码

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
 ]
]
输出

这是一个更紧凑的版本。它使用与原始版本相同的数据结构。函数
splitBox
和
insideBox
基本相同（只是以稍微不同的方式编写）

初始框不是逐个添加点，而是在开始处包含所有点，因此不需要执行
qtInsert
例程。在每个递归步骤中，包含多个点的长方体被拆分，点分布在子长方体上。这意味着所有具有多个点的节点都是叶子，因此也不需要检查

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 -> {}}]]]]
结果:

这可能不是您想要做的，但是Nearest[]可以创建一个最接近的函数[]，它是一个内置的四叉树结构

我认为您的代码并不像您预期的那样内存不足。它确实打破并改革了列表，但它倾向于保持大多数子列表不变

正如其他人所说，仍然可以使用Hold包装器和/或HoldXXX属性做得更好，以便通过引用模拟调用

有关某些相关数据结构实现的核心方法，请参阅

相关代码在笔记本Hemmecke-final.nb中（之所以这样命名是因为它实现了R.Hemmecke及其合著者提出的toric Groebner基算法）

我尝试使用Hold重新实现。。。属性，但我不太擅长，当代码向我发起攻击时，我放弃了它（错过了，但杀死了我的Mathematica会话）。因此，我有一个使用未记录的“原始”Mathematica数据类型的实现，该数据类型是惰性的，因此可以通过引用行为调用

所讨论的结构称为“expr包”，因为通用的Mathematica数据结构是“expr”。它类似于一个列表，但（1）它可以在一端增长（虽然不收缩），并且（2）与其他原始表达式类型（例如，版本8中的图形）一样，它具有可以通过提供的函数（可以说是API）访问和/或更改的组件。它的基本“元素”是惰性的，因为它们可以引用任何表达式（包括袋子本身），并且可以按照我将在下面指出的方式进行操作

上面的第一项提供了Sow/Reap实施的基础技术。这是第二个对下面的代码感兴趣的代码。最后，我将介绍一些关于数据结构的说明，因为没有正式的文档

我或多或少地保持了代码与原始代码相同的风格，特别是它仍然是一个在线版本（也就是说，元素不需要在一开始就全部加入，但可以单独添加）。换了几个名字。使基本结构类似于

节点（边界框、值、零或四个子节点）

如果存在子节点，则值字段为空。框和值字段由通常的Mathematica列表表达式表示，尽管使用专用头并使其更类似于C结构样式可能是有意义的。在命名各种字段访问/设置函数时，我确实这样做了

需要注意的一点是，这种原始数据类型消耗的内存开销比列表消耗的内存开销大得多。因此，我下面的变体将使用比最初发布的代码更多的内存。不是渐近更多，只是一个常数因子。此外，在访问或设置元素值方面，它需要一个固定的开销因子，而不是一个可比较的C结构。因此，这不是一个神奇的子弹，只是一个数据类型的行为，不应该给渐进的惊喜

一般快递袋说明。这些都是旧的，所以我不主张这一切仍然如图所示

这些功能存在于内部环境中

包 创建带有预设元素的expr包（可选）

巴格帕特 获取expr包的部件，类似于普通包的部件 出口。也可用于lhs，例如重置值

填充袋 将元素附加到包的末尾

我们也有一个袋长。用于迭代包

这些函数非常有用，原因有二

首先，这是在中创建可扩展表的好方法 Mathematica

第二，对袋子的内容物进行评估，然后放入 一个原始表达式，因此被屏蔽。因此，人们可以将其用作 “指针”（在C意义上）而不是作为对象 不需要等待等。以下是一些示例：

a = {1,2,a} (* gives infinite recursion *)
如果我们改用袋子，我们会得到一个自指结构

In[1]:= AppendTo[$ContextPath, "Internal`"];

In[2]:= a = Bag[{1,2,a}]
Out[2]= Bag[<3>]

In[3]:= expr1 = BagPart[a, All]
Out[3]= {1, 2, Bag[<3>]}

In[4]:= expr2 = BagPart[BagPart[a, 3], All]
Out[4]= {1, 2, Bag[<3>]}

In[5]:= expr1 === expr2
Out[5]= True
丹尼尔·利奇布劳
Wolfram Research

我没有时间玩你的代码，但作为回应，“…我仍然不习惯每次添加一个新点时复制整个树/表达式…”---你是否在寻找一种向函数添加内存的方法？如果是，请搜索“记住其值的函数”。如果不是你想要的，忽略它，我今天晚些时候会玩它。看起来很酷。：）不，我的意思是，当我添加一个点，而不是将节点插入到现有树中，实际上，我们正在生成一个完整的新树，丢弃旧树。我只是想知道当这样的表达 
AppendTo[$ContextPath, "Internal`"];

makeQuadTreeNode[bounds_] := Bag[{bounds, {}, {}}]

(*is pt inside box?*)

insideBox[pt_, box_] := 
 And @@ Thread[box[[1]] <= (List @@ pt) <= box[[2]]]

(*split bounding box into 4 children*)

splitBox[{{xmin_, ymin_}, {xmax_, ymax_}}] := 
 Map[makeQuadTreeNode, {{{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}}}]

bounds[qt_] := BagPart[qt, 1]
value[qt_] := BagPart[qt, 2]
children[qt_] := BagPart[qt, 3]

isLeaf[qt_] := value[qt] =!= {}
isSplit[qt_] := children[qt] =!= {}
emptyNode[qt_] := ! isLeaf[qt] && ! isSplit[qt]

(*qtInsert #1-return input if pt is out of bounds*)

qtInsert[qtree_, pt_] /; ! insideBox[pt, bounds[qtree]] := qtree

(*qtInsert #2-empty node (no value,no children)*)

qtInsert[qtree_, pt_] /; emptyNode[qtree] := value[qtree] = pt

(*qtInsert #2-currently a leaf (has a value and no children)*)

qtInsert[qtree_, pt_] /; isLeaf[qtree] := Module[
  {kids = splitBox[bounds[qtree]], currval = value[qtree]},
  value[qtree] = {};
  children[qtree] = kids;
  Map[(qtInsert[#, currval]; qtInsert[#, pt]) &, kids];
  ]

(*qtInsert #4-not a leaf and has children*)

qtInsert[qtree_, pt_] := Map[qtInsert[#, pt] &, children[qtree]];

getBoxes[ee_Bag] := 
 Join[{bounds[ee]}, Flatten[Map[getBoxes, children[ee]], 1]]
getPoints[ee_Bag] := 
 Join[{value[ee]}, Flatten[Map[getPoints, children[ee]], 1]]

qtDraw[qt_] := Module[
  {pts, bboxes},
  pts = getPoints[qt] /. {} :> Sequence[];
  bboxes = getBoxes[qt];
  Graphics[{EdgeForm[Black], Hue[0.2], Map[Disk[#, 0.01] &, pts], 
    Hue[0.7], EdgeForm[Red], 
    FaceForm[], (Rectangle @@ #) & /@ bboxes}, Frame -> True]]

len = 4000;
pts = RandomReal[{0, 2}, {len, 2}];
qt = makeQuadTreeNode[{{0.0, 0.0}, {2.0, 2.0}}];
Timing[Do[qtInsert[qt, pts[[i]]], {i, 1, len}]]

{1.6, Null}

a = {1,2,a} (* gives infinite recursion *)

In[1]:= AppendTo[$ContextPath, "Internal`"];

In[2]:= a = Bag[{1,2,a}]
Out[2]= Bag[<3>]

In[3]:= expr1 = BagPart[a, All]
Out[3]= {1, 2, Bag[<3>]}

In[4]:= expr2 = BagPart[BagPart[a, 3], All]
Out[4]= {1, 2, Bag[<3>]}

In[5]:= expr1 === expr2
Out[5]= True

tail[ll_] := BagPart[ll,2]
settail[ll_, ll2_] := BagPart[ll,2] = ll2
contents[ll_] := BagPart[ll,1]
setcontents[ll_, elem_] := BagPart[ll,1] = elem

createlinkedlist[elems__] := Module[
    {result, elist={elems}, prev, el},
    result = Bag[{elist[[1]],Bag[]}];
    prev = result;
    Do [el = Bag[{elist[[j]],Bag[]}];
        settail[prev, el];
        prev = el,
        {j,2,Length[elist]}];
    result
    ]

In[18]:= tt = createlinkedlist[vv,ww,xx]
Out[18]= Bag[<2>]

In[20]:= BagPart[tt,All]
Out[20]= {vv, Bag[<2>]}

Pointer = Internal`Bag
Contents[aa_Pointer, j_Integer] /;0<j<=Internal`BagLength[aa] :=
    Internal`BagPart[aa,j]
SetContents[aa_Pointer, j_Integer, e_] /; 0<j<=Internal`BagLength[aa] :=
    Internal`BagPart[aa,j] = e
SetContents[aa_Pointer, j_Integer, e_] /; j>BagLength[aa] :=
    (Do[Internal`StuffBag[aa,Null], {k,Internal`BagLength[aa]+1,j-1}];
    Internal`StuffBag[aa,e])

a = Bag[{1,2,a,6,t,y,99,Bag[{a,q,3,r,a,5,t}]}]
expr1 = BagPart[a, All]
expr2 = BagPart[BagPart[a, 3], All]

Contents[a, 4]
SetContents[a, 7, Contents[a,7]+5]
SetContents[a,11,33]