# Mapping points on the unit circle

I have a set of points P that are evenly spaced on a square grid of length 1.

I would like to map these points to the circle of radius 1 as nicely as possible, while preserving relative positions as much as possible. That is, the points in the square grid should map to the points in the unit circle.

How can this be done in Mathematica?

• Assuming that a map is a function, by what criterion should the mapping be done? Closest (highlighted) point on the unit circle? Aug 30, 2014 at 8:13
• Do the circle and square have the same center? (e.g. {0,0})? Aug 30, 2014 at 8:20
• Do you mean Circle or Disk?
– shrx
Aug 30, 2014 at 8:48

Your question is a little vague, but one possible mapping from a square to a circle is the following:

$$\begin{bmatrix}x^\prime\\y^\prime\end{bmatrix}=\begin{bmatrix}x\sqrt{1-\frac{y^2}{2}}\\y\sqrt{1-\frac{x^2}{2}}\end{bmatrix}$$

This transformation wrapped into a Mathematica function:

transformation[points_] := {#[[1]] Sqrt[1 - (#[[2]]^2/2)],
#[[2]] Sqrt[1 - (#[[1]]^2/2)]} & /@ # & /@ points;


And a little demonstration:

points = Table[{a, b}, {a, -1, 1, 0.2}, {b, -1, 1, 0.2}];

Show[
Graphics[{EdgeForm[Thick], White, Rectangle[{-1, -1}, {1, 1}]}],
ListPlot[Flatten[points, 1], AspectRatio -> 1, PlotStyle -> Red]
]
Show[
Graphics[{Thick, Circle[]}],
ListPlot[Flatten[transformation[points], 1], AspectRatio -> 1, PlotStyle -> Red]
]


• Nice answer, but no need for Show and ListPlot. Suggest Graphics[{EdgeForm[Thick], FaceForm[None], Rectangle[{-1, -1}, {1, 1}], Red, PointSize[Medium], Point[Flatten[points, 1]]}] and Graphics[{Thick, Circle[], Red, PointSize[Medium], Point[Flatten[transformation@points, 1]]}] Aug 30, 2014 at 5:35

I've used the Schwarz-Christoffel conformal map from the square to the disk plenty of times on this site (search around!); here's how to use it for this question:

pts = Flatten[Table[{x, y}, {x, -1, 1, 1/5}, {y, 1, -1, -1/5}], 1];

{Graphics[{Directive[AbsolutePointSize[3], ColorData[61, 8]], Point[pts]},
Frame -> True, PlotLabel -> "Before"],
Graphics[{Directive[AbsolutePointSize[3], ColorData[61, 8]],
Point[pts /. {x_, y_} :>
With[{ω = N[3 Beta[5/4, 5/4]/2]},
Through[{Re, Im}[JacobiSN[ω (x + I y), 1/2]
JacobiDC[ω (x + I y), 1/2]]]]]},
Frame -> True, PlotLabel -> "After"]} // GraphicsRow