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

Question

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

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?

I think this is a dupe. – J. M.'s missing motivation Oct 11 '16 at 01:07 — J. M.'s missing motivation, Oct 11 '16 at 01:07

kglr · Accepted Answer · 2016-10-11T00:57:51.237

8

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

edited Oct 11 '16 at 00:57

answered Oct 10 '16 at 22:48

kglr

394,356
18
477
896

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. – JPeter Oct 11 '16 at 03:36
I find more informations: http://mathematica.stackexchange.com/questions/72427/linescaledcoordinate-problem-for-exact-coordinates – JPeter Oct 11 '16 at 03:49

LouisB · Answer 2 · 2016-10-10T21:39:52.353

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.

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

2 Answers2