Wielokąty wypukłe

Łukasz Zosiak

Temat zadania

Rozwiazanie problemu

Znajdowanie wielokata wypuklego (Subscript[W, 0]) na zbiorze 𝔸

Generujemy losowy rozklad punktow

pnts=Table[RandomReal[{-4,4},2],{RandomInteger[{3,20}]}]

ListPlot[pnts,PlotStyle->PointSize[0.03`]]

Zastosowany zostanie algorytm wykorzystujacy fakt, ze elastyczna opaska "zalozona" na rozwazany zbior punktow przyjmuje wlasnie ksztalt poszukiwanego wielokata.
Na poczatku wybrany zostanie punkt "skrajny" tj. taki, ktory na pewno bedzie jednym z wierzcholkow - mozna np. wybrac dowolny punkt sposrod:

Sort[pnts,#1][[1]]&/@Flatten[Outer[Function[{a,b},#2[a[[#1]],b[[#1]]]]&,{1,2},{Less,Greater}],1]

Dalej wybrany zostanie punkt o najwiekszej drugiej wspolrzednej. Sortujemy zbior punktow wzgledem drugiej wspolrzednej i usuwamy ew. duplikaty

points=Sort[pnts//Union,#1[[2]]>#2[[2]]&]

Definiujemy kat pomiedzy para odcinkow dana trzema punktami:

Angle[p_,c_,n_]:=If[p≠c∧c≠n,ArcCos[(c-p).(n-c)/(Norm[c-p] Norm[n-c])],∞]

Wyrazenie znajdujace dla danych dwoch ponktow taki trzeci punkt sposrod pozostalych, aby kat byl jak najwiekszy (rownowaznie: aby uklad tych trzech punktow byl jak najblizszy wspoliniowemu) ma postac:

MinBend[p_,c_,points_]:={Angle[p,c,#],#}&/@points//Sort[#,#1[[1]]>#2[[1]]&]&//Last

Off[General::nord] (* nic groznego w tym przypadku *)

Zaczynajac od wybranego punktu poszukujemy kolejnych spelniajacych powyzszy warunek - az do momentu osiagniecia punktu poczatkowego - wykonujemy te procedure dla wylosowanego wczesniej zbioru:

ConvexHull[points_]:=NestWhile[Append[#,MinBend[Sequence@@Take[#,-2],points]//Last]&,{points[[1]]-{1,0},points[[1]]},Length[#]==Length[#//Union]&]//Take[#,{2,-1}]&;

poly=ConvexHull[pnts]

Wykonujemy testowy wykres obrazujacy znaleziony wielokat na tle punktow:

Show[ListPlot[poly,Joined->True,DisplayFunction->Identity],ListPlot[pnts,PlotStyle->{PointSize[0.03`]},DisplayFunction->Identity],DisplayFunction->$DisplayFunction]

Konstrukcja wielokata srodkowego

Definiujemy wielokat srodkowy zgodnie z tematem zadania oraz obwod wielokata:

MidpointPolygon[polygon_]:=Plus@@#/2&/@Partition[polygon,2,1,{1,-1}]//Append[#,First[#]]&

Aby zbadac zbieznosc definiujemy rowniez sume dlugosci bokow wielokata:

Perimeter[polygon_]:=Plus@@(Norm[Subtract[Sequence@@#]]&/@Partition[polygon,2,1,{1,-1}])

Konstruujemy ciag  {(Subscript[𝕎, n])}. (lim_(n->∞)) L((Subscript[𝕎, n]))=0 (iterujemy dopoki L((Subscript[𝕎, n]))>ϵ)

PolyMidpointSeries[polygon_,epsilon_]:=NestWhileList[MidpointPolygon,polygon,Perimeter[#]>epsilon&];

polyseries=PolyMidpointSeries[poly,(10^(-6))];Length[polyseries]

Wykonujemy rysunek 10  pierwszych wielokatow:

Draw[polygons_]:=Show[Graphics/@Line/@polygons]
Draw[Take[polyseries,50]]

Dla wylosowanego zbioru punktow granica ciagu (lim_(n->∞)) (Subscript[𝕎, n])jest:

polyseries//Last//Mean