8
$\begingroup$

Let us suppose that the points below define a path:

p = {{0, 0}, {5, 8.07774721}, {10, 4.24499363}, {20, 9.28880172}};
Graphics[{Red, PointSize[0.02], Point[p]}]

enter image description here

With the function from this answer I get the distances between points. They are not integer values and do not need to be integers.

partialPath = 
 EuclideanDistance[p[[# + 1]], p[[#]]] & /@ Range[Length[p] - 1] // N

$\{9.5,6.3,11.2\}$

With the function below I have given all the way:

pathTotal = Plus @@ partialPath

$27$

I am wanting to subdivide all the path into 300 equal parts.

pathTotal/300

$0.09$

The function below describes the percentage of each part of the path with respect to the total path: $9.5/27 = 0.351852$
$6.3/27 = 0.233333$
$11.2/27 = 0.414815$

porcentPath = {#/pathTotal} & /@ partialPath
Plus @@ porcentPath

$\left( \begin{array}{c} 0.351852 \\ 0.233333 \\ 0.414815 \\ \end{array} \right)$

${1.}$

I intended to use these percentages to try to obtain the value of $0.9$ obtained with pathTotal/300. $105.556$ divisions for Step1
$70$ divisions for Step2
$124.444$ divisions for Step3

subDivisions = porcentPath*300

$\left( \begin{array}{c} 105.556 \\ 70. \\ 124.444 \\ \end{array} \right)$

With that done the difference between each point and tried to use the function Subdivide to try to get the points I want to:

d = Differences[p];
Subdivide[d[[#]], First@subDivisions[[#]]] & /@ Range[3]

But I get error

Then I round the values and I get sucess:

subDivisions2 = Round[subDivisions]

$\left( \begin{array}{c} 106 \\ 70 \\ 124 \\ \end{array} \right)$

d = Differences[p];
Subdivide[d[[#]], First@subDivisions2[[#]]] & /@ Range[3];

How could I do all of this in a more effective way?

$\endgroup$
8
$\begingroup$

An alternative approach using LineScaledCoordinate from GraphUtilities:

Needs["GraphUtilities`"]

p = {{0, 0}, {5, 8.07774721}, {10, 4.24499363}, {20, 9.28880172}};
n = 30;
pts = LineScaledCoordinate[p, N@(#/n)] & /@ Range[0, n];

ListPlot[{p, pts}, PlotStyle -> {Blue, Directive[PointSize[Medium], Red]}, 
 Joined -> {True, False}]

Mathematica graphics

Update:

Even simpler alternative is to use MeshFunctions -> {"ArcLength"}:

ListPlot[p, Joined -> True, MeshFunctions -> {"ArcLength"}, 
 Mesh -> (n-1), MeshStyle -> Directive[Red, PointSize[Medium]]]

Mathematica graphics

$\endgroup$
  • $\begingroup$ This answer is closer than I intend to use. Mainly in exchange of directions, where I can see the constant length of 0.9 that I wanted. $\endgroup$ – JPeter Oct 11 '16 at 3:36
  • $\begingroup$ I find more informations: mathematica.stackexchange.com/questions/72427/… $\endgroup$ – JPeter Oct 11 '16 at 3:49
4
$\begingroup$

Perhaps something like this, except with the number of points you actually wanted:

p = {{0, 0}, {5, 8.07774721}, {10, 4.24499363}, {20, 9.28880172}};

n = 30;
partialPath = 
  EuclideanDistance[p[[# + 1]], p[[#]]] & /@ Range[Length[p] - 1] // N;
nparts = n*partialPath/Total[partialPath] // Round;
check = TrueQ[n == Total@nparts]

s1 = Table[
   Subdivide[p[[i, 1]], p[[i + 1, 1]], nparts[[i]]], {i, 1, 
    Length[p] - 1}];
s2 = Table[
   Subdivide[p[[i, 2]], p[[i + 1, 2]], nparts[[i]]], {i, 1, 
    Length[p] - 1}];
s = Transpose[{Flatten@s1, Flatten@s2}];

Graphics[{Blue, PointSize[0.02], Point[s],
  Red, PointSize[0.02], Point[p]}]

The list s will contain some redundant points. One way to remove the redundancy is to use s = Union[s]. A side effect of Union, however, is that it returns a sorted list. The redundant points are given by p[[2;;-2]] so they could be removed using DeleteCases.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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