5 Additional upper and lower values added to the FindRoot routine to prevent solutions being provided greater than upVal
source | link

Straight segments

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.

Curved segments

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.

Straight segments

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[#], #} & /@ 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.

Curved segments

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.

Straight segments

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.

Curved segments

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.

4 added 378 characters in body
source | link

Straight segments

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[#], #} & /@ 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.

Curved segments

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.

Straight segments

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[#], #} & /@ 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.

Curved segments

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}]
 
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}]]}]
 ]

Mathematica graphics

Well, unless I messed it up.

Straight segments

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[#], #} & /@ 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.

Curved segments

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.

3 added 746 characters in body
source | link

Straight segments

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[#], #} & /@ 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.

Curved segments

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}]

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}]]}]
 ]

Mathematica graphics

Well, unless I messed it up.

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[#], #} & /@ 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.

Straight segments

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[#], #} & /@ 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.

Curved segments

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}]

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}]]}]
 ]

Mathematica graphics

Well, unless I messed it up.

2 added 185 characters in body
source | link
1
source | link