# Is there an inverse function of LineScaledCoordinate?

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.

• This function pathParameter[pts, P] would require Element[P,Line[pts] ? Nov 15, 2021 at 9:01
• @UlrichNeumann P should on Line[pts], if P is far away from the line, the returned value should greater than 1 or less than 0. Nov 15, 2021 at 10:40

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

ClearAll[invLSC]
invLSC[pl_, p_] /; Element[p, Line @ pl] := Module[{arclengths, index,
mr = MeshRegion[pl, Line[Range[Length @ pl]]]},
index = Last @ RegionMeshMeshNearestCellIndex[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]


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]


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]


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]


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}

• Thanks for your answer, but it's too slow to be practical, I need to do it in real time. Nov 15, 2021 at 10:47