11
$\begingroup$

I would like to map my data on Archimedes' spiral and preserve the distance between points on the curve. The test data consists of 20 evenly spaced {x,y} coordinates:

data = Table[{i, i}, {i, 20}]

When I map the data to a spiral, the points are not evenly spaced anymore:

Show[ListPlot[{#[[2]] Sin[#[[1]]], #[[2]] Cos[#[[1]]]} & /@ data, 
  AspectRatio -> 1, PlotRange -> {{-20, 20}, {-20, 20}}], 
 ParametricPlot[{t Sin[t], t Cos[t]}, {t, 0, 20}]]

Mathematica graphics

I found this question that links to the algorithm that iteratively generates evenly distributed points on a spiral, but how can I apply this to my set of data points?

The final goal that I'm trying to achieve is to create a function that I can use with ImageTransformation that will remap an image that roughly resembles a line to an Archimedes' spiral.

$\endgroup$
5
  • 1
    $\begingroup$ Related: (8454) $\endgroup$
    – C. E.
    Aug 19, 2014 at 11:52
  • $\begingroup$ @Pickett Thanks, I saw this, but again this uses the approach to subdivide a predefined curve. I don't think I can use this because my data will contain noise, and therefore I cannot directly assign my data points to the pre-generated points on a curve. $\endgroup$
    – shrx
    Aug 19, 2014 at 12:00
  • 6
    $\begingroup$ Maybe changing your data to Sqrt[2 #] & /@ Table[{i, i}, {i, Range[0, 1/2 20^2, 1/2 20]}] or similar ? $\endgroup$ Aug 19, 2014 at 12:05
  • $\begingroup$ @b.gatessucks yes, this looks like I could use it $\endgroup$
    – shrx
    Aug 19, 2014 at 12:09
  • $\begingroup$ Somewhat related: (655857) $\endgroup$
    – Mr.Wizard
    Aug 19, 2014 at 20:38

2 Answers 2

8
$\begingroup$

Using @b.gatessucks' hint, I solved it with the following transformation:

max = Max[data]; 
Show[
  ListPlot[{Sqrt[max #[[2]]] Sin[Sqrt[max #[[1]]]], 
            Sqrt[max #[[2]]] Cos[Sqrt[max #[[1]]]]} & /@ data, 
    AspectRatio -> 1, PlotRange -> {{-20, 20}, {-20, 20}}], 
  ParametricPlot[{t Sin[t], t Cos[t]}, {t, 0, 20}]]

Mathematica graphics

$\endgroup$
4
$\begingroup$

Borrowing from Szcabolcs' answer here:

Off[FunctionInterpolation::ncvb]

PointsOnCurve[fun_, lim_, points_] :=

 Module[{arclength, curvepoints},

  arclength = 
   Derivative[-1][FunctionInterpolation[Evaluate @ Norm @ D[fun, t], {t, 0, lim}]];

  curvepoints = fun /. t -> # & /@
      Table[InverseFunction[arclength][x], {x, 0, #, # / points}] & [arclength[lim]];

  Show[
   ParametricPlot[fun, {t, 0, lim}],
   Graphics[{Red, PointSize[0.02], Point[curvepoints]}]]]

PointsOnCurve[{t Sin[t], t Cos[t]}, 20, 30]

enter image description here

PointsOnCurve[{Cos[t], Sin[2 t]}, 2 Pi, 30]

enter image description here

$\endgroup$
4
  • $\begingroup$ You use the variable points twice, as number of points, and as a points list $\endgroup$
    – hieron
    Aug 19, 2014 at 13:05
  • $\begingroup$ @hieron Thanks, very attentive, I changed the answer $\endgroup$
    – eldo
    Aug 19, 2014 at 13:13
  • $\begingroup$ Switching off the message is not needed if you define spiral SetDelayed, which simplifies also the spiralpoints expression. $\endgroup$
    – hieron
    Aug 19, 2014 at 13:52
  • 1
    $\begingroup$ I am not looking for a function to generate the points, I want to remap the points that I will obtain experimentally. $\endgroup$
    – shrx
    Aug 19, 2014 at 15:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.