5

I know a useful function LineScaledCoordinate through animate-point-going-around-a-triangle, so does it have an inverse function?

Needs["GraphUtilities`"];
pts = {{0, 0}, {1, 0}, {0.6, 0.4}, {0.1, 0.5}};
P = LineScaledCoordinate[pts, 0.3]

Suppose this function is called pathParameter, pathParameter[pts, P] should return 0.3.

Related link: Line Scaled Segment or Arc length parametrization for Line

matrix42
  • 6,996
  • 2
  • 26
  • 62

3 Answers3

2
onSegment[{p1_, p2_}, p_, tol_:10^(-10)]:=
  (Det[{p2 - p1, p - p1}] < tol) && ((p - p1) . (p2 - p1) > 0 && (p2 - p) . (p2 - p1) >= 0 || And @@ MapThread[Equal, {p, p1}])

pathParameter[coord_?MatrixQ, p:{x_, y_}, tol_:10^(-10)] :=
Block[{segs, pos, dist, pdist},
    segs = Partition[coord, 2, 1];
    pos = Position[segs, _?(onSegment[#, p, tol] &), {1} , 1, Heads->False];
    If[Length[pos] == 0, Return[-1]];
    dist = Map[Norm, Drop[coord - RotateLeft[coord], -1]];
    pdist = Total[dist[[;;pos[[1,1]] - 1]]] + Norm[p - segs[[pos[[1, 1]], 1]]];
    pdist / Total[dist]
]
halmir
  • 15,082
  • 37
  • 53
2
ClearAll[invLSC]
invLSC[pl_, p_] /; Element[p, Line @ pl] := Module[{arclengths, index,
  mr = MeshRegion[pl, Line[Range[Length @ pl]]]}, 
 index = Last @ Region`Mesh`MeshNearestCellIndex[mr, p];
 arclengths = PropertyValue[{mr, 1}, MeshCellMeasure];
 (Total[arclengths[[;; index - 1]]] + Norm[pl[[index]] - p]) / Total[arclengths]]

invLSC[___] := -1

Examples:

2D

Needs["GraphUtilities`"];

pts = {{0, 0}, {1, 0}, {0.6, 0.4}, {0.1, 0.5}};

{P = LineScaledCoordinate[pts, .3], invLSC[pts, P]}

{{2.37301, 6.88155}, 0.3}
{P2 = LineScaledCoordinate[pts, .8], invLSC[pts, P2]}
{{4.41186, 4.25237}, 0.8}
{SeedRandom[1]; P3 = RandomReal[1, 2], invLSC[pts, P3]}
{{0.817389, 0.11142}, -1}
SeedRandom[1];
pts = RandomReal[10, {15, 2}];

q = RandomReal[1, 10];

Grid[Prepend[{#, pt = LineScaledCoordinate[pts, #], invLSC[pts, pt]} & /@ q, Style[#, 14] & /@ {"q", "pt = LineScaledCoordinate[pts, q]", "invLSC[pts, pt]"}], Dividers -> All]

enter image description here

pl = RandomPoint[Line @ pts, 10];

Grid[Prepend[{#, s = invLSC[pts, #], LineScaledCoordinate[pts, s]} & /@ pl, Style[#, 14] & /@ {"pt", "s = invLSC[pts, pt]", "LineScaledCoordinate[pts, s]"}], Dividers -> All]

enter image description here

3D

SeedRandom[1];
pts = RandomReal[10, {15, 3}];

q = RandomReal[1, 10];

Grid[Prepend[{#, pt = LineScaledCoordinate[pts, #], invLSC[pts, pt]} & /@ q, Style[#, 14] & /@ {"q", "pt = LineScaledCoordinate[pts, q]", "invLSC[pts, pt]"}], Dividers -> All]

enter image description here

pl = RandomPoint[Line @ pts, 10];

Grid[Prepend[{#, s = invLSC[pts, #], LineScaledCoordinate[pts, s]} & /@ pl, Style[#, 14] & /@ {"pt", "s = invLSC[pts, pt]", "LineScaledCoordinate[pts, s]"}], Dividers -> All]

enter image description here

kglr
  • 394,356
  • 18
  • 477
  • 896
1
Needs["GraphUtilities`"];
pts = {{0, 0}, {1, 0}, {0.6, 0.4}, {0.1, 0.5}};
P = LineScaledCoordinate[pts, 0.3];
x[t_?NumericQ] := LineScaledCoordinate[pts, t][[1]]
y[t_?NumericQ] := LineScaledCoordinate[pts, t][[2]];
sol = NMinimize[{({x[t], y[t]} - P) . ({x[t], y[t]} - P), 
    0 <= t <= 1}, t];
t /. sol[[2]]

0.3

SeedRandom[111];
Needs["GraphUtilities`"];
pts = {{0, 0}, {1, 0}, {0.6, 0.4}, {0.1, 0.5}};
randoms = RandomReal[{0, 1}, 20]
points = LineScaledCoordinate[pts, #] & /@ randoms;

inverse[pts_, P_] := Module[{x, y, sol, t}, x[t_?NumericQ] := LineScaledCoordinate[pts, t][[1]]; y[t_?NumericQ] := LineScaledCoordinate[pts, t][[2]]; sol = NMinimize[{({x[t], y[t]} - P) . ({x[t], y[t]} - P), 0 <= t <= 1}, t]; t /. sol[[2]]]; inverse[pts, #] & /@ points

{0.183729, 0.779252, 0.755279, 0.203977, 0.298739, 0.538596, 0.00195475, 0.715802, 0.169596, 0.858267, 0.212156, 0.304449, 0.339743, 0.42689, 0.318241, 0.016407, 0.398779, 0.998553, 0.240465, 0.718291}

cvgmt
  • 72,231
  • 4
  • 75
  • 133