Skip to main content

list manipulation - How do I split up a curve into chords of equal length?


I have a curve that is defined as f[x] and what I'm attempting to do is to divide the curve into equal straight lengths for a number of segments of my choosing that I've defined as nSeg.



I've created a sheet that can work through and determine the (x,y) co-ordinates for each segment, but I'm having to manually manipulate the equations to create a single equation for Mathematica to find the roots for.


The straight length of the curve I've defined as;


chordL = Table[
Sqrt[(Subscript[x, i + 1] - Subscript[x,i])^2 +
(f[Subscript[x, i + 1]] - f[Subscript[x, i]])^2
], {i, 1, nSeg}
]

This creates a list of equations for the length of each segment. What I would like to do is make each part of the list equal to each other so that I can feed this into FindRoot later in the sheet so that if I decide to change the number of segments from 8 to 10, the sheet can be refreshed from a single variable.


FindRoot[*combined equations*, {Subscript[x, 2], 1}, {Subscript[x, 3], 2}]


The above is an example of how I'm currently doing it and it means I've a sheet for each value of nSeg, which isn't a smart way to work and I'm manually defining which variables to solve independently of the value of nSeg, even though the first and last co-ordinate will always be known.


I'm quite new to Mathematica and would really appreciate a nudge in the right direction to combine the equations in the first part to give the equations to solve in FindRoot (which I'm using instead of Solve for speed) in a flexible manner, and also increment the number of variables to solve given that x1 will always be 0 and x(nSeg+1) will always be known too as these are the start and end points of the curve which are defined by the input at the beginning of the sheet.



Answer




I'll assume you want to fix the first and last point and then plot the segments. Quick and dirty approach (I'll fix the first point at $x=0$ and the last at x=upVal; also note that actually nSeg isn't the number of segments here, but never mind):


upVal = 6;
nSeg = 10;
chordL = Table[
Sqrt[(x[i + 1] - x[i])^2 + (f[x[i + 1]] - f[x[i]])^2], {i, 1,

nSeg}];
combEqs = # == d & /@ chordL;

That is, I set the length of all the segments to $d$, for which I will solve. Here's how to define the list of vars (with initial conditions, which are arbitrarily chosen here):


ClearAll[vars, x];
vars = Append[{x[#], #, x[1]+10^-6, upVal-10^-6} & /@ Range[2, nSeg],{d, 1}]

you can see I am adding $d$, the segment length, as a variable to solve for. Let's try for $f(x)=\sin(x)$:


f[x_] := Sin[x];
x[1] = 0;

x[nSeg + 1] = upVal;
sol = FindRoot[combEqs, vars];


points = Table[{{x[i], f[x[i]]}, {x[i + 1], f[x[i + 1]]}}, {i, 1,
nSeg}];

Show[
Plot[f[x], {x, x[1], 1.1 x[nSeg + 1]}],
Graphics@Line[points /. sol],

Graphics[{Red, PointSize[Large], Point[Flatten[points, 1] /. sol]}]
]

Mathematica graphics


So it seems to work.



If I just want to split up the curve in segments of equal length along the curve, I could do it like this:


ClearAll[findx, length];
findx[ell_, f_] := x /. FindRoot[length[x, f] \[Equal] ell, {x, 1}]
length[xf_?NumericQ, f_] := NIntegrate[Sqrt[1 + f'[z]^2], {z, 0, xf}]


Here, length gives the length of a curve f[x] from x=0 to x=xf, and findx uses that to obtain the coordinate x at which the length from x=0 to x=xf is ell. Then, we find the total length, split it into equal pieces $\delta L$, and use findx to obtain the values $x_n$ at which the length from the starting point is $n\delta L$:


nsegs = 10;
f[x_] := Cos[x^2]
xup = 2;
totalLength = length[xup, f];
dL = totalLength/nsegs;
xvals = Table[findx[n*dL, f], {n, 0, nsegs}];
Show[
Plot[f[x], {x, 0, xup}],

Graphics[{Red, PointSize[Large],
Point[Transpose[{xvals, f /@ xvals}]]}]
]

And here is the result:


Mathematica graphics


Well, unless I messed it up.


Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

equation solving - Invert and fit implicitly defined curve

I need to fit an implicitly defined curve. I thought I could get some data out of Solve , and then using FindFit . Therefore, I would like to find the relation the parametric curve defined by $F(x,y)=0$: Solve[-(1/2) + 1/2 (0.41202 BesselK[0, 0.1 Sqrt[x^2 + y^2]] + (0.101483 x BesselK[1, 0.1 Sqrt[x^2 + y^2]])/Sqrt[x^2 + y^2]) == 0, y] But I can't get an output: Solve was unable to solve the system with inexact coefficients or the system obtained by direct rationalization of inexact numbers present in the system. Since many of the methods used by Solve require exact input, providing Solve with an exact version of the system may help. >> Edit: In particular, I would like to fit the data coming from the curve with the expression of another curve, and not with a function $f(x)$. In particular, since this clearly looks like a cardioid , I would like it to fit to something like it. What other strategies could I try?

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...