Ref. [1] has an interesting observation. For any closed polygon, if one takes the midpoint repeatedly, the polygon will be eventually smoothed out. The authors observed that the curves will become an elliptic.
randline[n_Integer, a_: - 1, b_: 1] := RandomReal[{a, b}, {n, 2}] mpt[pts_, n_: 3] := Table[Sum[pts[[Mod[i + j - 1, Length@pts, 1]]], {j, 1, n}]/n, {i, 1, Length[pts]}] nl[npts_, nitr_, n_: 2, a_: - 1, b_: 1] := NestList[mpt[#, n] &, randline[npts, a, b], nitr]; randplot[npt_, nit_, nst_: 10, na_: 2, pt_: False, init_: False, a_: - 1, b_: 1] := Module[{n, i0 = Min[Max[1, nst], nit + 1]}, n = nl[npt, nit, na, a, b]; Show[ If[pt, Graphics[ Flatten[Table[{Hue[(i - i0)/(nit + 1 - i0)], Line[closeline[n[[i]]]], PointSize[Medium], Point[n[[i]]]}, {i, nst, nit + 1}], 1]], Graphics[ Flatten[Table[{Hue[(i - nst)/(nit + 1 - i0)], Line[closeline[n[[i]]]]}, {i, nst, nit + 1}], 1]] ], If[init, Graphics[{Opacity[0.6], Line[closeline[n[[1]]]]}], Graphics[] ] ] ]
I here also present the spectrum
reference:
[1]:http://www.cs.cornell.edu/cv/ResearchPDF/PolygonSmoothingPaper.pdf
No comments:
Post a Comment