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