Pathfinding บนพื้นที่ 2D

Question

ฉันจะค้นหาเส้นทางที่สั้นที่สุดหรือใกล้ที่สุดระหว่างจุดสองจุดที่เส้นทางถูก จำกัด ภายในพื้นที่ 2 มิติได้อย่างไร

ขั้นแรกให้พิจารณากลุ่มของบรรทัดต่อไปนี้:

SeedRandom[1];
points = RandomPoint[Disk[], 70];
nf = Nearest[points];
lines = Line /@ Partition[points, 2];
start = First[nf[{0, -1}]];
end = First[nf[{0, 1}]];
Graphics[{lines, Blue, PointSize[Large], Point[start], Red, Point[end]}]

ในการแก้ปัญหานี้สามารถสร้างกราฟที่จุดตัดเป็นจุดยอด อย่างไรก็ตามจะเกิดอะไรขึ้นถ้าเรามีการรวมกันของภูมิภาคที่ซับซ้อนมากขึ้นดังต่อไปนี้:

SeedRandom[1];
numdisks = 60;
numpolys = 40;

disks = MapThread[
   Disk[#1, #2] &, {RandomPoint[Disk[], numdisks], 
    RandomReal[1/5, numdisks]}];

polygons = MapThread[
   Translate[#1, #2] &, {RandomPolygon[8, numpolys, 
     DataRange -> {-.15, .15}], RandomPoint[Disk[], numpolys]}];

Graphics[{
  disks, polygons, PointSize[Large], Cyan, Point[{-.4, .9}], Magenta, 
  Point[{-.8, -.6}]
}]

ควรมีเส้นทางบางส่วนที่ประกอบด้วยส่วนของเส้นที่พาเราจากจุดสีฟ้าไปยังจุดสีม่วงแดง ฉันต้องการแก้ตัวอย่างเฉพาะนี้ในแง่ที่ไม่เชื่อเรื่องพระเจ้าโดยไม่คำนึงถึงคุณสมบัติพิเศษใด ๆ ของพื้นฐานดั้งเดิม กล่าวอีกนัยหนึ่งเราได้รับเพียงภูมิภาคเดียวImageMesh[ColorNegate[Graphics[{polygons, disks}]]]และไม่มีทางที่จะทำลายมันลงไปอีก

Answer 1

นี่คือแนวทางที่ควรสร้างโซลูชันที่ดีที่สุดในระดับโลก (รหัสด้านล่าง):

หลังจากการประมวลผลล่วงหน้าบางส่วนประสิทธิภาพจะสามารถใช้งานได้แบบเรียลไทม์ดังที่แสดงใน gif การประมวลผลล่วงหน้าจะต้องดำเนินการหนึ่งครั้งสำหรับแต่ละภูมิภาค แต่ใช้เวลาน้อยกว่า 3 วินาทีในเครื่องของฉันสำหรับภูมิภาคที่มีปัญหา

แนวคิดก็คือทุกเส้นทางที่สั้นที่สุดจะประกอบด้วยเส้นตรงระหว่างจุดบนขอบเขตของพื้นที่ (และแน่นอนว่าจุดเริ่มต้นและจุดสิ้นสุด) หากต้องการดูสิ่งนี้ให้จินตนาการว่าอยู่ในห้องที่มีรูปร่างของพื้นที่และเส้นทางที่สั้นที่สุดของผู้สมัครของคุณจะถูกทำเครื่องหมายด้วยสตริง: ถ้าคุณดึงสตริง (เพื่อลดความยาวของเส้นทางที่ใช้โดยสตริง) สตริงจะ ถูกบางมุมของห้องจับได้ แต่จะเป็นเส้นตรงระหว่างนั้น ณ จุดนี้เราทราบด้วยว่าต้องพิจารณาเฉพาะมุมที่ชี้เข้าด้านใน: ไม่มีเส้นทางที่สั้นที่สุดที่จะไปยังมุมที่หันหน้าออกไปด้านนอกของพื้นที่ดังที่เห็นได้จากการเปรียบเทียบกับสตริง

การใช้งานจะเลือกมุมที่ชี้เข้าด้านในทั้งหมดpointData(ซึ่งมีข้อมูลสำหรับฟังก์ชันที่insideQอธิบายไว้ด้านล่างด้วย) และสร้างรายการของเส้นที่เป็นไปได้ทั้งหมดระหว่างจุดดังกล่าวจากนั้นเลือกเส้นที่อยู่ภายในพื้นที่ (นี่คือขั้นตอนที่จะใช้ ในขณะที่เนื่องจากมี ~ 25,000 บรรทัดเพื่อตรวจสอบภูมิภาคด้านบน) เพื่อให้ได้เส้นทางจริงตั้งแต่ต้นจนจบเราจำเป็นต้องเพิ่มเส้นทั้งหมดจากสองจุดนั้นไปยังจุดขอบเขตที่ชี้เข้าด้านใน แต่รายการนั้นสั้นกว่าและสามารถคำนวณได้แบบเรียลไทม์

สิ่งที่ยุ่งยากคือการได้รับฟังก์ชั่นที่สามารถตรวจสอบได้อย่างรวดเร็วว่ามีสายอยู่ในภูมิภาคหรือไม่ - การทำงานของภูมิภาคในตัวนั้นช้าเกินไป (และมีข้อบกพร่อง) ดังนั้นเราจึงจำเป็นต้องมีโซลูชันที่กำหนดเอง

นี้จะกระทำโดยฟังก์ชั่นlineWithinQ, intersectingQและinsideQ:

• insideQตรวจสอบว่าเส้นใต้จุดทดสอบเข้าด้านในจากขอบของขอบเขตหรือไม่โดยการคำนวณผลคูณสามของเวกเตอร์ขอบเสริมสองตัวและเส้นที่เป็นปัญหา เรายังรวบรวมฟังก์ชันเพื่อประสิทธิภาพสูงสุด

• intersectingQตรวจสอบว่าเส้นภายใต้การทดสอบตัดกับเส้นเขตใด ๆ หรือไม่ (ไม่นับการสัมผัสเส้นนั้น) ฟังก์ชันนี้แก้ไขจุดตัดของเส้นทั้งสองได้อย่างมีประสิทธิภาพ (กำหนดจุดสิ้นสุด) และตรวจสอบว่าจุดตัดนั้นอยู่ระหว่างจุดสิ้นสุด เพื่อประสิทธิภาพสูงสุดฟังก์ชันนี้จะถูกคอมไพล์และยกเลิกทันทีที่พบจุดตัด

• สุดท้ายlineWithinQตรวจสอบว่าบรรทัดอยู่ในภูมิภาคหรือไม่ในสองขั้นตอน:

  • ขั้นแรกให้ตรวจสอบว่าเส้นนั้นชี้ไปที่ภูมิภาคหรือไม่ด้วย insideQ
  • ประการที่สองตรวจสอบว่าเส้นนั้นข้ามเขตแดน ณ จุดใด ๆ ด้วยหรือไม่intersectingQ(อย่าลืมว่าการสัมผัสไม่นับ)

เนื่องจากฟังก์ชั่นทำงานเฉพาะสำหรับเส้นระหว่างจุดบนเส้นขอบการเพิ่มจุดเริ่มต้นและจุดสิ้นสุดจึงแตกต่างกันเล็กน้อย (ดังที่เห็นได้จากการจัดการstartและendภายในโค้ดRegionShortestPathFunctionด้านล่าง): ก่อนอื่นเราจะกรองเส้นจากจุดขอบเขตใดก็ได้ไปยังจุดเริ่มต้น / สิ้นสุดการใช้lineWithinQงานเนื่องจากฟังก์ชันยังคงใช้งานได้ตราบเท่าที่จุดแรกอยู่บนขอบเขต ( insideQตรวจสอบว่าเส้นนั้นชี้ไปยังพื้นที่โดยมองจากจุดเริ่มต้นของเส้นเท่านั้น) ในการตรวจสอบว่าเส้นตรงตั้งแต่ต้นจนจบนั้นถูกต้องหรือไม่เราเพียงแค่ตรวจสอบว่าเส้นนั้นตัดกันหรือไม่

Module[
 {cond, l, i},
 cond = Unevaluated@FullSimplify[0 < t < 1 && 0 < u < 1] /. 
   First@Solve[{t, 1 - t}.{{x1, y1}, {x2, y2}} == {u, 
        1 - u}.{{x3, y3}, {x4, y4}}, {t, u}];
 cond = cond /. 
   Thread[{x1, y1, x2, y2} -> Table[Indexed[l, {i, j}], {j, 4}]];
 cond = cond /. Thread[{x3, y3} -> Table[Indexed[p1, i], {i, 2}]];
 cond = cond /. Thread[{x4, y4} -> Table[Indexed[p2, i], {i, 2}]];
 With[
  {cond = cond},
  intersectingQ = Compile @@ Hold[
     {{l, _Real, 2}, {p1, _Real, 1}, {p2, _Real, 1}},
     Module[{ret = False}, 
      Do[If[cond, ret = True; Break[]], {i, Length@l}]; ret],
     CompilationTarget -> "C", RuntimeAttributes -> {Listable}, 
     Parallelization -> True
     ]
  ]
 ]

Module[
 {cond, x1, y1, z1, x2, y2, v1, v2},
 cond = {x1, y1, z1}.Append[Normalize@{x2, y2}, 1] > 0 /. 
    Abs -> RealAbs // FullSimplify[#, x2^2 + y2^2 > 0] &;
 cond = cond /. Thread[{x1, y1, z1} -> Table[Indexed[v1, i], {i, 3}]];
 cond = cond /. Thread[{x2, y2} -> Table[Indexed[v2, i], {i, 2}]];
 insideQ = Compile @@ {
    {{v1, _Real, 1}, {v2, _Real, 1}},
    cond,
    CompilationTarget -> "C", RuntimeAttributes -> {Listable}, 
    Parallelization -> True
    }
 ]

lineWithinQ[lineData_, {{p1_, v1_}, {p2_, _}}] :=
 insideQ[v1, p2 - p1] && ! intersectingQ[lineData, p1, p2]

Options[RegionFindShortestPath] = {"MonitorProgress" -> True};

RegionFindShortestPath[region_?MeshRegionQ, start : {_, _}, end : {_, _}, opts : OptionsPattern[]] :=
 RegionFindShortestPath[region, start, opts][end]
RegionFindShortestPath[region_?MeshRegionQ, start : {_, _}, opts : OptionsPattern[]] :=
 RegionFindShortestPath[region, opts][start]

RegionFindShortestPath[region_?MeshRegionQ, OptionsPattern[]] :=
 Module[
  {lines, lineData, pointData, pathData},
  lines = MeshPrimitives[RegionBoundary@region, 1][[All, 1]];
  lineData = Catenate /@ lines;
  pointData = Cases[(* select inwards pointing corners *)
     {p_, {__, z_} /; z > 0, c_} :> {p, c}
     ]@Catenate[
     Transpose@{
         #[[All, 2]],
         Sequence @@ Table[
           Cross[#, {-1, -1, 1} #2] & @@@
            Partition[
             Append[z]@*Normalize /@ Subtract @@@ #,
             2, 1, {1, 1}
             ],
           {z, 0, 1}
           ]
         } & /@
      FindCycle[Graph[UndirectedEdge @@@ lines], \[Infinity], All]
     ];
  pathData = With[
    {expr := 
      Select[lineWithinQ[lineData, #] &]@Subsets[pointData, {2}]},
    If[OptionValue["MonitorProgress"],
      ResourceFunction["MonitorProgress"][expr, 
       "CurrentDisplayFunction" -> None],
      expr
      ][[All, All, 1]]
    ];
  RegionShortestPathFunction[pointData, lineData, 
   Join[pathData, lines]]
  ]

RegionShortestPathFunction[data__][start : {_, _}, end : {_, _}] :=
 RegionShortestPathFunction[data][start][end]
RegionShortestPathFunction[pointData_, lineData_, pathData_][start : {_, _}] :=
 RegionShortestPathFunction[pointData, lineData, Join[
   pathData,
   Select[lineWithinQ[lineData, #] &][{#, {start, {}}} & /@ 
      pointData][[All, All, 1]]
   ], start]

RegionShortestPathFunction[pointData_, lineData_, pathData_, start_][end : {_, _}] :=
 With[
  {allLines = Join[
     pathData,
     Select[lineWithinQ[lineData, #] &][{#, {end, {}}} & /@ 
        pointData][[All, All, 1]],
     If[! intersectingQ[lineData, start, end], {{start, end}}, {}]
     ]},
  Quiet@
   Check[
    FindShortestPath[
     Graph[UndirectedEdge @@@ allLines, 
      EdgeWeight -> EuclideanDistance @@@ allLines], start, end],
    {}
    ]
  ]

summaryBoxIcon = Graphics[
  {{[email protected], 
    Polygon@{{0, 0}, {0, 1}, {1, 1}, {1, -1}, {-2, -1}, {-2, 
       1.5}, {-1, 1.5}, {-1, 0}}}, {Red, 
    Line@{{0.5, 0.5}, {0, 0}, {-1, 0}, {-1.5, 1}}}, 
   AbsolutePointSize@4, Point[{0.5, 0.5}], {Point[{-1.5, 1}]}}, 
  Background -> GrayLevel[0.93], PlotRangePadding -> Scaled[0.1], 
  FrameStyle -> Directive[Thickness[Tiny], [email protected]], 
  ElisionsDump`commonGraphicsOptions
  ]

MakeBoxes[
  f : RegionShortestPathFunction[pointData_, lineData_, pathData_, 
    start_ | PatternSequence[]], fmt_] ^:=
 BoxForm`ArrangeSummaryBox[
  RegionShortestPathFunction,
  f,
  summaryBoxIcon,
  {
   BoxForm`SummaryItem@{"Corner points: ", Length@lineData},
   BoxForm`SummaryItem@{"Start set: ", Length@{start} > 0}
   },
  {
   BoxForm`SummaryItem@{"Possible segments: ", Length@pathData}
   },
  fmt
  ]

SeedRandom[1];
numdisks = 60;
numpolys = 40;

disks = MapThread[
   Disk[#1, #2] &, {RandomPoint[Disk[], numdisks], 
    RandomReal[1/5, numdisks]}];
translatePoly[poly_, pos_] := 
  Polygon[# + pos & /@ poly[[1]], poly[[2]]];
polygons = 
  MapThread[
   translatePoly[#1, #2] &, {RandomPolygon[8, numpolys, 
     DataRange -> {-.15, .15}], RandomPoint[Disk[], numpolys]}];
start = {-.4, .9};
end = {-.8, -.6};
Graphics[{disks, polygons, PointSize[Large], Cyan, Point[start], 
  Magenta, Point[end]}]
mesh = DiscretizeRegion[RegionUnion[Join[polygons, disks]]];

spf = RegionFindShortestPath[mesh]

Manipulate[
 Show[
   mesh,
   Graphics[{Thick, Red, Dynamic@Line@spf[p1, p2]}]
  ],
 {p1, Locator},
 {p2, Locator}
 ]

ดังที่แสดงให้เห็นฟังก์ชันสามารถใช้เป็นRegionFindShortestPath[mesh][start,end](โดยที่RegionFindShortestPath[mesh]ให้ a RegionShortestPathFunctionพร้อมกับข้อมูลที่คำนวณไว้ล่วงหน้าที่แคชไว้ด้านใน) ชุดค่าผสมทั้งหมดเช่นRegionFindShortestPath[mesh,start,end]และRegionFindShortestPath[mesh,start][end]ทำงานได้ดีโดยมีการแคชข้อมูลให้มากที่สุด

Answer 2

ฉันคิดวิธีแก้ปัญหาที่ไม่เป็นทางการและไม่มีประสิทธิภาพซึ่งอาจเสี่ยงต่อปัญหาการตัดเย็บและมีความอ่อนไหวต่อขนาดของเซลล์ตาข่าย แต่ฉันเชื่อว่ามันสร้างเส้นทางสั้น ๆ ที่ดีพอสมควร บางทีคนอื่นอาจปรับปรุงสิ่งนี้หรือแนะนำวิธีแก้ปัญหาทางเลือก:

SeedRandom[1];
numdisks = 60;
numpolys = 40;

disks = MapThread[
   Disk[#1, #2] &, {RandomPoint[Disk[], numdisks], 
    RandomReal[1/5, numdisks]}];
translatePoly[poly_, pos_] := 
  Polygon[# + pos & /@ poly[[1]], poly[[2]]];
polygons = 
  MapThread[
   translatePoly[#1, #2] &, {RandomPolygon[8, numpolys, 
     DataRange -> {-.15, .15}], RandomPoint[Disk[], numpolys]}];
start = {-.4, .9};
end = {-.8, -.6};
Graphics[{disks, polygons, PointSize[Large], Cyan, Point[start], 
  Magenta, Point[end]}]
mesh = DiscretizeRegion[RegionUnion[Join[polygons, disks]]];

cells = MeshCells[mesh, 2][[All, 1]];
prims = MeshPrimitives[mesh, 2];
meshcentroids = RegionCentroid /@ prims;
nprim = Nearest[meshcentroids -> "Index"];
startcell = cells[[First[nprim[start]]]];
endcell = cells[[First[nprim[end]]]];
connectedCells[cells1_, cells2_] := 
 Length[Intersection[cells1, cells2]] == 2
cellGr = RelationGraph[connectedCells[#1, #2] &, cells, 
   VertexCoordinates -> meshcentroids];
path = FindShortestPath[cellGr, startcell, endcell];

Show[Graphics[
  {EdgeForm[LightRed], FaceForm[LightYellow], mesh, PointSize[Large], 
   Cyan, Point[start], Magenta, Point[end]}
  ], HighlightGraph[cellGr, PathGraph[path]]
 ]

โค้ดด้านบนค้นหาเส้นทางในกราฟการเชื่อมต่อแบบเมช นั่นคือกราฟของสามเหลี่ยมที่อยู่ติดกัน (ใช้ขอบร่วมกัน) ในตาข่ายดิสเครต เห็นได้ชัดว่าเส้นทางนี้กระตุกมากดังนั้นรหัสต่อไปนี้จึงพยายามค้นหา 'การกระโดด' ที่ยาวที่สุดตามเส้นทางที่สามารถข้ามจุดยอดได้ แต่อยู่ในพื้นที่:

(** from the currentPoint, try to draw a line that to the furthest 
  possible point on the path that stays within the region **)
getcoords[cell_] := AnnotationValue[{cellGr, cell}, VertexCoordinates]
pathcoords = Join[{start},getcoords /@ path, {end}];
maxiline[currentPoint_, coords_] := 
 SelectFirst[Reverse[coords], 
  Quiet[Check[RegionWithin[mesh, Line[{currentPoint, #}]], False]] &]
lpath = NestWhileList[maxiline[#, pathcoords] &, start, # != end &];
Graphics[{mesh, Red, Line[lpath], PointSize[Large], Cyan, 
  Point[start], Magenta, Point[end]}]

Answer 3

นี่คือการลองครั้งแรก สามารถปรับปรุงได้ แต่ต้องเริ่มต้นที่ไหนสักแห่ง โปรแกรมต่อไปนี้ใช้พื้นที่จุดเริ่มต้นและจุดสิ้นสุดและขนาดขั้นตอน มันทำให้พล็อตของเส้นทาง (สีแดง) และจุดที่พยายาม (สีเขียว) แต่ใช้รถเพราะไม่มีเงื่อนไขเบื้องต้นในการใช้ประโยชน์จึงต้องใช้ขั้นตอนมาก เป็นโปรแกรมแบบวนซ้ำดังนั้นเราต้องขยาย "$ RecursionLimit" ดูแลด้วย "stepsize" ทำให้ใหญ่เท่าที่เหมาะสมมิฉะนั้นจำนวนขั้นตอนจะระเบิด นอกจากนี้ความแตกต่างของพิกัด x และ y ระหว่างจุดเริ่มต้นและจุดสิ้นสุดจะต้องเป็นหลายขั้นตอน มิฉะนั้นจะไม่มีวันพบจุดจบ และเพื่อความเรียบง่ายควรเลือกจุดเริ่มต้นเหนือจุดสิ้นสุด โปรดทราบว่าเส้นทางอาจค่อนข้างใหญ่ดังนั้นจึงไม่สมเหตุสมผลที่จะพิมพ์ แนวคิดคือคุณจะทำอะไรบางอย่างกับมันนอกเหนือจากการพิมพ์ นอกจากนี้คุณจะต้องมีพื้นที่จริงไม่ใช่รูปหลายเหลี่ยมที่แปลแล้วซึ่งจะใช้งานได้กับ "RegionMember" นี่คือโปรแกรมขอให้สนุก:

getPath[region_, start_, end_, stepsize_] := 
  Module[{path = {pos = start}, step = stepsize, wrong = {}, remem, 
    search},
   If[Mod[(end - start)/step, 1] != {0, 0}, 
    Print["Difference between end and start must be a multiple of \
stepsize."]; Return[]];
   remem = RegionMember[region];
   search[pos_] := Module[{},
     If[ Norm[pos - end] < 0.001, Return[{}]];
     Which[
      tp = 
       pos + {0, -1} step;  ( ! MemberQ[path, tp]) && ( ! 
         MemberQ[wrong, tp]) && remem[tp], AppendTo[path, tp]; 
      search[tp],
      tp = 
       pos + {1, 0} step ;  ( ! MemberQ[path, tp]) && ( ! 
         MemberQ[wrong, tp]) && remem[tp], AppendTo[path, tp]; 
      search[tp],
      tp = 
       pos + {-1, 0} step; ( ! MemberQ[path, tp]) && ( ! 
         MemberQ[wrong, tp]) && remem[tp], AppendTo[path, tp];  
      search[tp],
      True, AppendTo[wrong, path[[-1]]];  path = Delete[path, -1]; 
      If[path == {}, Return[{}]]; search[path[[-1]]];
      ]];
   search[start];
   Show[Region[region], 
     Graphics[{Green, Point[wrong], Thick, Red, Line[path], Black, 
       PointSize[0.03], Point[end] , Point[start]}], 
     PlotRange -> {{-1, 4}, {-1, 5}}, Axes -> True] // Print;
   path
   ];

เราสร้างพื้นที่ตามอำเภอใจเลือกจุดเริ่มต้นและจุดสิ้นสุดและปล่อยให้โปรแกรมค้นหาเส้นทาง

region = RegionUnion[Disk[{0, 3.2}], Disk[{0.9, 2.2}, 0.5], 
   Disk[{1.9, 3.}, 0.8], Disk[{2.5, 1.8}, 0.6], Disk[{1.8, .6}, .9], 
   Disk[{0, 0}]];
start = {0., 3.2};
end = {0, 0};
stepsize = 1/10;
$RecursionLimit = 10^4;
path = getPath[region, start, end, stepsize];

Answer 4

เริ่มต้นด้วยสิ่งนี้:

RegionUnion[Disk[{0, 0}, 2], Disk[{3, 0}, 2]];

Region[%]

สำหรับวงกลมที่เรียบง่ายและจุด:

RegionDistance[Disk[{0, 0}, 2], {3, 0}]

1

Graphics[{Disk[{0, 0}, 2], Point[{3, 0}], Red, 
  Line[{{0, 0}, {3, 0}}]}]

หากความตั้งใจหลักยังคงทำงานร่วมกับการทำงานRandomความคิดของ @flinty ก็ไม่เลวที่จะดูว่าสิ่งเหล่านี้เชื่อมโยงกันหรือไม่และมีเส้นทางอยู่หรือไม่

นี่คือวิธีการที่จะสร้างเครื่องบินจัดเรขาคณิตของและCircle Polygonสำหรับแต่ละศูนย์นั้นเป็นที่รู้จักและSortหรืออื่น ๆ ก็ทำได้อย่างง่ายดาย

ขั้นตอนนี้จะต้องทำซ้ำด้วยความระมัดระวังสำหรับแต่ละชุดขนาดเล็กที่ใช้งานได้

การจัดการกับความTransformล้มเหลวสำหรับBooleanRegion.

ℜpolygon = 
 Region@RegionUnion[
   Table[Polygon[
     Plus[cent[[i]], #] & /@ RandomReal[{-0.15, 0.15}, {8, 2}]], {i, 
     30}]]
ℜcircle = 
 Region@RegionUnion[
   MapThread[
    Disk[#1, #2] &, {RandomPoint[Disk[], numdisks], 
     RandomReal[1/5, numdisks]}]]

ℜcomp = 
 Region@RegionUnion[ℜpolygon, ℜcircle]

แต่ RegionNearest และ RegionDistance ไม่ทำงานไม่ได้กำหนดไว้สำหรับ BooleanRegion

RegionDistance[
 Region@RegionUnion[{Disk[{0, 0}, 2], Disk[{1, 1}, 2], 
    Disk[{1, -1}, 2]}], {3, 0}]

Graphics[{Disk[{0, 0}, 2], Disk[{1, 1}, 2], Disk[{1, -1}, 2], 
  Point[{3, 0}], Red, 
  Line[{{Sqrt[(3/2 + 1/10 (-5 - 4 Sqrt[5]))^2 + (-3 + 
        1/5 (5 + 4 Sqrt[5]))^2], 0}, {3, 0}}]}]

สิ่งนี้ก็ต้องเป็นไฟล์BooleanRegion.

Mathematica V12 มีในตัวRandomInstanceและGeometricScene

RandomInstance[GeometricScene[{a, b, c, d, g, e, f}, {
   a == {-1/2, 0}, b == {1/2, 0}, Line[{f, a, b, e}],
   p0 == Polygon[{e, g, f}],
   p1 == Style[Polygon[{a, c, b}], Yellow],
   p2 == Style[Polygon[{b, d, c}], Magenta],
   p3 == Style[Polygon[{d, c, g}], Green],
   p4 == Style[Polygon[{g, c, a}], Blue],
   p5 == Style[Polygon[{e, b, d}], Purple],
   p6 == Style[Polygon[{g, a, f}], Orange],
   GeometricAssertion[{p0, p1, p2, p3, p4, p5, p6}, "Similar"]}], 
 RandomSeeding -> 4]

มีในตัวGeometricAssertionพร้อมกับข้อเสนอกระบวนการกำเนิดเพื่อสร้างเส้นทางพร้อมกับวัตถุ และสิ่งนี้ช่วยให้รูปหลายเหลี่ยมแบบสุ่มที่ดีกว่าและสมจริงมากขึ้น SimplePolygonQและให้รายละเอียดของเส้นทางในเครื่องบินและจะจัดการกับความสัมพันธ์ทางเรขาคณิตมากขึ้นเช่น

Splice อาจถูกนำมาใช้ใหม่ใน V12.1 และใหม่กว่า ฉันสามารถพบได้ในคำตอบอื่น ๆ ของคำถามในชุมชนนี้ ลำดับ @@ แบบเก่า.

AnnotationValueไม่ได้อยู่ในเอกสารของฉันเกี่ยวกับ Mathematica V12.0.0 แต่AnnotationValueทำงานบน V12.0.0 ดังนั้นนี่คือบิวท์อินที่ไม่มีค่าในคำถามนี้: ล้มเหลว

ดังนั้นส่วนที่เหลือไม่ทำงาน

ใช้งานได้กับ V12.0.0 และเหมือนกัน:

Show[Graphics[{mesh, PointSize[Large], Cyan, Point[start], Magenta, 
   Point[end]}], Subgraph[cellGr, PathGraph[path]]]

การใช้

connectedCells[cells1_, cells2_] := 
 Length[Intersection[cells1, cells2]] == 1

ในรหัสการใช้งานด้านบนให้:

Show[Graphics[{mesh, PointSize[Large], Cyan, Point[start], Magenta, 
   Point[end]}], 
 Subgraph[cellGr, PathGraph[path], EdgeStyle -> {Thick, Green}]]

เร็วกว่า แต่ยังมีปัญหาในส่วนล่างซ้ายของไฟล์DiscretizeRegion.

mesh = DiscretizeRegion [RegionUnion [เข้าร่วม [รูปหลายเหลี่ยมดิสก์]], MaxCellMeasure -> 1]

mesh = DiscretizeRegion[RegionUnion[Join[polygons, disks]], 
   MaxCellMeasure -> {"Length" -> 1/15}, PrecisionGoal -> None];
cells = MeshCells[mesh, 2][[All, 1]];
prims = MeshPrimitives[mesh, 2];
meshcentroids = RegionCentroid /@ prims;
nprim = Nearest[meshcentroids -> "Index"];
startcell = cells[[First[nprim[start]]]];
endcell = cells[[First[nprim[end]]]];
connectedCells[cells1_, cells2_] := 
 Length[Intersection[cells1, cells2]] == 1
cellGr = RelationGraph[connectedCells[#1, #2] &, cells, 
   VertexCoordinates -> meshcentroids];
path = FindShortestPath[cellGr, startcell, endcell];

Show[Graphics[{mesh, PointSize[Large], Cyan, Point[start], Magenta, 
   Point[end]}], Subgraph[cellGr, PathGraph[path]]]

สิ่งนี้แสดงให้เห็นว่าต้องมีการเปลี่ยนตาข่ายแบบปรับได้ด้วยตาข่ายที่มีความหนาแน่นสม่ำเสมอเพื่อให้ได้เส้นทางที่เหมาะสมที่สุดหากใช้การทำสามเหลี่ยม ทุกซอกทุกมุมทุกการบุกรุกที่เล็กที่สุดส่วนขยายทุกส่วนที่ชี้เข้าหรือออกด้านนอกจะดึงดูดตาข่ายสามเหลี่ยมและจะทำให้เกิดการสั่นในเส้นทางที่สั้นที่สุด

ปกติจะนำไปสู่การสั่นตราบใดที่การวัดเซลล์สูง สำหรับขนาดเล็กเมื่อหยุดสั้นที่สุดจากการสั่นและเข้าโดยตรงและอยู่ภายในหยดตาข่าย หากจะนำเขตแดนมาพิจารณาให้ดีขึ้นสิ่งที่สั้นที่สุดอาจอยู่ในบริเวณศูนย์กลางของ Blobs มากขึ้น

เป็นการประนีประนอมระหว่างเวลาและการกำกับว่าเส้นทางที่สั้นที่สุดจะสั้นแค่ไหน