5
$\begingroup$

___________________ FOLLOWUP TO THE QUESTION : _____________________

Does anyone know how I could quantify the thickness of the spiral AND the thickness of the empty space between the arms? I know that right now it depends on the value put into the AbsoluteThickness, but I need to be able to put in a number in, say, nanometers. Does anyone have any ideas on this might be done?

________________________END OF FOLLLOWUP__________________

I can plot a thin spiral using just:

$ r=\frac{\theta }{2 \pi };$

PolarPlot[theta/2 Pi,{theta,0,2 Pi}]

but is there a way to plot a spiral that has actual area (not just a visually thicker line, but actual 2D spiral as if you took a long rectangle and curled it up, if that makes sense...)? Like these: enter image description here

Essentially, I'm trying to bounce a beam of light off a lens which has this pattern machined out of it, so I need to be able to modify the thickness of the trenches to see how much light will get reflected. The beam of light is estimated as a matrix of points. So I need to have this pattern also represented as a matrix.

Improve this question
$\endgroup$
6
  • $\begingroup$ What exactly do you mean by "convert the set of points that makes up such a spiral into a 2D array"? $\endgroup$ Commented Jun 30, 2015 at 22:02
  • $\begingroup$ @march, PolarPlot creates a list of points of the type (r, theta), I need to take that list and convert it into type (x,y) $\endgroup$ Commented Jun 30, 2015 at 22:08
  • 2
    $\begingroup$ This caused me to experiment with drawing random spiral galaxies. Thanks for the diversion! $\endgroup$ Commented Jul 1, 2015 at 0:05
  • 3
    $\begingroup$ do you mean just PolarPlot[theta/2 Pi, {theta, 0, 2 Pi}, PlotStyle -> {AbsoluteThickness[8], CapForm["Round"]}, Axes -> None] // Binarize // ImageData // MatrixPlot ? by setting large ImageSize you can increase the resolution. you can also use Position[imagedata,1] and ImageValuePositions[im,1] for coordinates $\endgroup$ Commented Jul 1, 2015 at 7:18
  • $\begingroup$ @amr. By far the simplest solution. I recommend posting it as an answer. $\endgroup$ Commented Jul 1, 2015 at 13:07

4 Answers 4

Reset to default
3
$\begingroup$

Here is the code I posted in my comment above:

plot = PolarPlot[theta/2 Pi, {theta, 0, 2 Pi}, Axes -> None, PlotStyle -> {AbsoluteThickness[8], CapForm["Round"]}]; plot // Binarize // ImageData // MatrixPlot

pixelated spiral

I left it at low resolution, but you can just increase the Graphics ImageSize to get very good precision. Though you'd probably want to use Thickness like other posters here did rather than AbsoluteThickness. Since we left the plot in Graphics form you can use Show to get different resolutions without fiddling with the original plot code: Show[plot, ImageSize -> 1000].

Many of the image processing functions automatically Rasterize Graphics expressions, such as Binarize in this case. Other potentially relevant functions: Positions, ImageValuePositions, PixelValuePositions, ImageValue, ImageLevels, SkeletonTransform, ImageCrop.

Update in response to comment below: To keep {0,0} centered I used the Plot's own PlotRange setting and extended it. This centers it in the Graphics before rasterizing.

plot = PolarPlot[theta/(2 Pi), {theta, 0, 2 Pi}, Axes -> None, PlotStyle -> {AbsoluteThickness[8], CapForm["Round"]}]; centerize[plot_Graphics, center_: {0, 0}, options___] := Module[{plotRangeSettings, plotRange, fourCorners, furthest, symmetricPlotRange}, (*isolate numeric plot range*) plotRangeSettings = ReplaceList[PlotRange, Options[plot]]; plotRange = First[Cases[plotRangeSettings, {{_?NumberQ, _}, {_, _}}]]; (*pick out furtherst corner and symmetrize its coordinates*) fourCorners = Tuples[plotRange]; furthest = First[MaximalBy[fourCorners, EuclideanDistance[#, center] &]]; symmetricPlotRange = Sort /@ Transpose[{-furthest, furthest}];(*convert to {{xmin,xmax},{ymin,ymax}}*) Show[plot, options, PlotRange -> symmetricPlotRange]]; centerize[plot] // Binarize // ImageData // MatrixPlot

centered spiral

You can see the centering by including the axes:

centerize[plot, {0, 0}, ImageSize -> 800, Axes -> True, Ticks -> None] // Binarize // ImageData // MatrixPlot

centered spiral with axes

Improve this answer
$\endgroup$
6
  • $\begingroup$ I copy pasted your code and for some reason my picture come out with colors inverted >.> ... do you know why that might be? Also, I tried making the spiral bigger (plot=PolarPlot[theta/2 Pi,{theta,0,4 Pi},Axes->None,PlotStyle->{AbsoluteThickness[55],CapForm["Round"]},ImageSize->{500,500}];) , but it cropped the edges, how I do make it so it fits the whole thing into a square image? $\endgroup$ Commented Jul 1, 2015 at 18:02
  • 1
    $\begingroup$ @Solarmew no problemos. i'm guessing Binarize is choosing a different background based on some threshold, or something like that. Just use ColorNegate to get the polarity you need. For the cropping issue you could adjust the PlotRange but the easiest is to set a padding: PlotRangePadding -> 3. By the way, you can do something like ComposeList[{Binarize, ColorNegate, ImageData, MatrixPlot}, plot] // Column to follow these kinds of sequential transformations. $\endgroup$ Commented Jul 1, 2015 at 19:38
  • $\begingroup$ Just as an addendum, ImageCrop[image] is useful for cutting back exactly after over-padding (such as with PlotRangePadding in this case). $\endgroup$ Commented Jul 3, 2015 at 6:54
  • $\begingroup$ I'm still confused as to how to get the spiral to start at the origin >.> ... I'm using PlotRangePadding -> Automatic and that seems to be working well as far as not cropping the edges and not creating extra space, but I'd rather have extra space if that means the spiral is centered. And by centered I mean that it STARTS unwinding at the origin, not the picture itself is centered. $\endgroup$ Commented Jul 14, 2015 at 16:05
  • $\begingroup$ I'm currently busy but I'll see if I can figure something out later today. In any case, feel free to re-accept to someone else's answer. $\endgroup$ Commented Jul 14, 2015 at 21:38
7
$\begingroup$ 
parm = CoordinateTransform["Polar" -> "Cartesian", {u/2 Pi, u}]; n = {#2, -#1} & @@ (Normalize@D[parm, u]); ParametricPlot[{{r n + parm}, {parm}}, {u, 0, 10 Pi}, {r, -1.5, 1.5}, MaxRecursion -> 5]

enter image description here

ParametricPlot[{{u^2 /400 r n + parm}, {parm}}, {u, 0, 10 Pi}, {r, -1.5, 1.5}, MaxRecursion -> 5]

enter image description here

Improve this answer
$\endgroup$
5
$\begingroup$

Another way will be to simply take advantage of the CapForm primitives and get those rounded lines. I am using a transformation rule on the Graphics object generated by the PolarPlot function to change the default lines into a rounded one. 

plot=PolarPlot[theta/2 Pi, {theta, 0, 20 Pi},Axes->None,PlotStyle->Black, PlotRange -> All]; plot/.Line[point_] :> {CapForm["Round"],Thickness[.03],Line[point]}

enter image description here

Update: An accurate way to address the following requirement!

"I need to have this pattern also represented as a matrix"

  1. First discretize the 2D line plot of the spiral and form a region distance function based on that discrete curve.
  2. Sample a good number of points on the $\{x,y\}$ plane where the spiral lies.
  3. Use the region distance function to mark only those points which satisfy you trench thickness criterion.

Here is the commented code to generate the requested matrix:

reg=DiscretizeGraphics@plot;(* Step 1: Discretize 2D *) df = RegionDistance[reg]; (* Step 1: Distance function *) (* Step 3: Sample point but extend the bounding box by {-4, +4} *) samplePt=Outer[List, ##] & @@ (Range[##, .8] & @@@ (# + {-4, +4} &/@RegionBounds[reg])); (* Get your image matrix! TRENCH Thickness = 2 *) ImageData@ImageRotate@Image@Map[If[df[#] <= 2., 1., 0.] &,samplePt, {2}]

Image looks like this.

enter image description here

Here goes a visualization of the 2D spiral mesh and the generated $19415$ points on the Cartesian plane with an Euclidean distance of utmost $2$ units from the spiral. One can generate less points by choosing coarser (>0.8) sampling in Range[##, .8]. Code follows after the image.

enter image description here

Show[Graphics@{PointSize@Tiny, Orange,Point/@ (If[df[#] <= 2, #, Unevaluated[Sequence[]]] & /@ Flatten[samplePt,1])}, HighlightMesh[reg, Style[1, Opacity[.7], Red]]]
Improve this answer
$\endgroup$
5
$\begingroup$

Update July 14: Fixed Centering of Positions

Here is a summary of the code:

image = Graphics[{ Thickness[0.03] , CapForm["Round"] , Line[Table[ theta/(2 Pi) {Cos[theta], Sin[theta]} , {theta, 0, 20 Pi, 20 Pi/599} ]] , RGBColor[1., 0., 0.], AbsolutePointSize[1], Point[{0, 0}] } , ImageSize -> {100, 100} ] centralPosition = Position[ImageData @ image, {1., 0., 0.}]; array = ReplacePart[1 - MorphologicalComponents@image, First@centralPosition -> 1]; positions = ComponentMeasurements[array, "Mask"][[1, 2]]["NonzeroPositions"]; shiftedPositions = # - First@centralPosition & /@ positions;

To make it so that the image spirals out from the actual origin, I placed a red pixel right at the center of the image. We then use ImageData, which returns an array of color data for each pixel. We find the Position of the red pixel, add this point back into the array, and shift the positions by the position of the red pixel. As shown in the third figure below, this makes it so that the origin is at the center of the spiral.

Again: you can change the ImageSize to be whatever you wish. Increasing it yields better resolution. In addition, increasing the number of points in the Table that defines the spiral might help. Finally, I have used Thickness[0.03] so that the thickness of the spiral is always 3% of the figure size.

Generating the images below. The first image is just image. The third and fourth images are, respectively,

MatrixPlot[array, ImageSize -> 250] MatrixPlot[1 - array, ImageSize -> 250]

Finally, to generate the second figure, we have to get the positions of both the spiral and the negative of the spiral and assign to the positions the values 1 or 0 depending on whether they're in the spiral or not. To get the negative:

inversePositions = ComponentMeasurements[1 - array, "Mask"][[1, 2]]["NonzeroPositions"]; shiftedInversePositions = # - First@centralPosition & /@ inversePositions;

Finally, to get the list of coordinates with values, we do

finalArray = Join[ Flatten@{#, 1} & /@ shiftedPositions , Flatten@{#, 0} & /@ shiftedInversePositions ];

and to plot it, we do

ListDensityPlot[finalArray , InterpolationOrder -> 0 , Axes -> True , ImageSize -> 250]

This last takes a little bit of time, and will take longer and longer the bigger the original image, so be careful.

enter image description here

Original Post

Here's how I would go about doing drawing the spirals.

image = Graphics[{ AbsoluteThickness[10] , CapForm["Round"] , Line[Table[ theta/(2 Pi) {Cos[theta], Sin[theta]} , {theta, 0, 20 Pi, 20 Pi/599} ]] } ,ImageSize -> {500, 500} ]

Changing the argument of AbsoluteThickness[20] allows you to get different thicknesses. Changing the number of points in the Line makes it look nicer as well. The "Round" Capform makes the ends of the Line look nice. This particular code results in

enter image description here

(Update: there was an error in the original post. Image Size should be ImageSize, and since this was wrong, it used the default width of 360 instead.) We set the ImageSize in order to determine how many points there are in the image. For instance, taking ImageSize -> {500, 400} makes the grid have a width of 500 points and a height of 400 points. You can change this to, say, 1000 by 1000, but you will need to change the AbsoluteThickness argument, because the thickness won't scale with the size of the image. If you want it to, you can use Thickness instead, and the argument will be the fraction of the image width that the line takes up.

Now, to get the $(x,y)$ components, we can first call MorphologicalComponents on the image to get a matrix of 1's where there is black and 0's where there is white as

array = 1 - MorphologicalComponents @ image;

Finally, we extract the positions via

positions = ComponentMeasurements[array, "Mask"][[1, 2]]["NonzeroPositions"];

ComponentMeasurements[array, "Mask"][[1, 2]] returns a SparseArray object, and we use the SparseArray method "NonzeroPositions" to extract the positions at which the image array is non-zero, which is where the original image is black.

If we plot array using

MatrixPlot[array]

we get the figure below, and the coordinates of the orange positions are in the list positions.

Update If you need to shift the positions so that the original center of the spiral is at the origin, do the following. If your grid is 500 by 400, say, then do:

shiftedPositions = {-501/2, -401/2} + # & /@ positions;

This takes the shift {-501/2,-401/2} and adds it to every element in the list by constructing the pure function {-501/2, -401/2} + # & and Maping it (shorthand: /@) over the list positions, which applies the pure function to every element of the list.

enter image description here

Improve this answer
$\endgroup$
13
  • $\begingroup$ but this just makes it LOOK thicker, doesn't it? ... If you plot this in cartesian coordinates and pick a point (x,y) somewhere in the middle of a black region, there AREN'T actually points immediately all around it (x±ɛ, y±ɛ), even though it looks like there are. I would like to be able to construct a matrix out if this graph where if the graph is white, the point is 0, otherwise it's 1. $\endgroup$ Commented Jun 30, 2015 at 22:21
  • 1
    $\begingroup$ @Solarmew. Oh I see! I misunderstood. We might be able to kluge something together using image processing stuff in Mathematica by taking the image that is generated and finding the points that are black, but I'm a novice at best with that stuff. We need to use MorphologicalComponents. How many points do you want in the image? $\endgroup$ Commented Jun 30, 2015 at 22:24
  • $\begingroup$ @Solarmew. I've updated the answer with one possibility for getting what you want. Please take a look, and we can fine-tune it as needed! By the way, it would be useful to edit the body and title of your original question to include the information about getting the (x,y) coordinates in your comment above. Making the lines thicker is not a very difficult question, but getting the (x,y) coordinates of the spiral is a very interesting question, and probably useful to many people. $\endgroup$ Commented Jun 30, 2015 at 22:45
  • $\begingroup$ wow, very fancy :] I believe this will work! Thanks for your help! $\endgroup$ Commented Jun 30, 2015 at 22:48
  • $\begingroup$ @Solarmew. Thank you for the accept! But it is a good idea to wait at least a couple of days to accept the answer, because that motivates others to chime in with their own takes. There are many gifted Mathematica users on this site, and I'm sure that someone could come up with something simpler, more straight-forward, and more elegant than my answer. Feel free to "un-accept" if you'd like to spur more answers (but make sure to edit your title and question with more about what you want in order to get more people interested). $\endgroup$ Commented Jun 30, 2015 at 22:51

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.