# Finding the consecutive distance of n-dimensional points with Mathematica

I want to create a list of (n-dimension, average of points) with 10,000 points per n-dimension.

I can't figure out how to take the distance of consecutive points. Say in 2-dimensions, there are 3 points, how can I create a distance function that will calculate the distance between point 1 and 2, point 2 and 3, and point 3 and 1?

I have tried writing a definition with the distance formula, I have also tried subtracting the points and using dot product. I am not getting the correct results, and also get an error for 1 dimension.

Below is my attempt for 3-dimensions, with 3 points.

Thank you in advance for your help!

List of 3 n -dimensional points

ndim[n_] := ndim[n] = Table[ Table[Random[Real, {0, 1}], {i, 1, n}], {3}]

ndim[1]

> {{0.101636}, {0.552763}, {0.746901}}

ndim[2]

>{{0.487501, 0.793056}, {0.0315906, 0.406843}, {0.539288, 0.479365}}

ndim[3]

>{{0.137648, 0.0813221, 0.272689}, {0.196472, 0.76574, 0.145624}, {0.730333, 0.690326, 0.575955}}

Consecutive distance square between 2 points for 3 data points per n-dimension:

dsqr[n_] := Table[(ndim[n][[i, 1]] - ndim[n][[i, 2]])^2,  {i, 1, Length[ndim[n]]}]

dsqr[1]

> During evaluation of In[254]:= Part::partw: Part 2 of {0.101636} does not exist.

> During evaluation of In[254]:= Part::partw: Part 2 of {0.552763} does not exist.

> During evaluation of In[254]:= Part::partw: Part 2 of {0.746901} does not exist.

> During evaluation of In[254]:= General::stop: Further output of Part::partw will be suppressed during this calculation.

> {(0.101636 - {{0.101636}, {0.552763}, {0.746901}}[[1, 2]])^2, (0.552763 - {{0.101636}, {0.552763}, {0.746901}}[[2, 2]])^2, (0.746901 - {{0.101636}, {0.552763}, {0.746901}}[[3, 2]])^2}

dsqr[2]

> {0.0933638, 0.140814, 0.00359085}

dsqr[3]

> {0.00317264, 0.324066, 0.0016005}

Average distance for 3 data points for n-dimension:

davg[n_] := Plus @@ Sqrt[dsqr[n]]/Length[dsqr[n]];
davg[2]

> 0.24691

davg[3]

>0.221867

Table with ordered pair (n-dimension, Dave) for 3 data points:

orderpairs[n_] := Table[{i, davg[n]}, {i, 1, n}];
orderpairs[3]

> {{1, 0.221867}, {2, 0.221867}, {3, 0.221867}}


• "...calculate the distance between point 1 and 2, point 2 and 3, and point 3 and 1..." - I usually do something like EuclideanDistance @@@ Partition[pts, 2, 1, 1] for this. Jul 14, 2022 at 15:05
• I need to find the distance by creating lists from tables. Jul 14, 2022 at 15:18
• Then, why couldn't you do Mean[EuclideanDistance @@@ Partition[dsqr[n], 2, 1, 1]]? Jul 14, 2022 at 15:28

Here a couple of inspirations:

n = 1000000;
d = 3;
a = RandomReal[{0, 1}, {n, d}];
dists1 = Sqrt[# . #] & /@ Subtract[RotateLeft[a], a]; //
RepeatedTiming // First
dists2 = Norm /@ Subtract[RotateLeft[a], a]; // RepeatedTiming // First
dists3 = Sqrt[Total[# #, {2}]] &[Subtract[RotateLeft[a], a]]; //
RepeatedTiming // First
dists4 =
Sqrt[NDSolveFEMMapThreadDot[#, #] &[
Subtract[RotateLeft[a], a]]]; // RepeatedTiming // First
dists1 == dists2 == dists3 == dists4


0.0693251

0.0496381

0.0184081

0.0125145

True

You can get the average by just evaluating

av = Mean[dist1];


Also notable if you can arange the to be in transposed form (SoA layout, SoA = Structure of Arrays):

b = Transpose[a];
dist5 = Sqrt[#1 #1 + #2 #2 + #3 #3] &[
Subtract[RotateLeft[#], #] &[b[[1]]],
Subtract[RotateLeft[#], #] &[b[[2]]],
Subtract[RotateLeft[#], #] &[b[[3]]]
]; // RepeatedTiming // First


0.0109765

This is run on an Apple M1 with NEON instruction set which roughly corresponds to Intel's SSE2, IIRC. But modern Intel processors support AVX2, so this might be a bit faster than the other implementations above on a not-too-dated Intel CPU (2013-ish or later). Or maybe not. (Boy, am I happy to have not to break my head over this anymore...)

• Thank you, Henrik. I have added to my question the code for my second attempt. Jul 14, 2022 at 18:59
• FWIW, Differences[a] saves a modest amount time over Subtract[..]. Jul 15, 2022 at 14:57
• Yes, Michael, I observed that, too. Actually, I used that in a previous version of the post. But then I got the impression (from OP's latest edit, which you happened to erase) that OP wants cyclic differences, and I think Differences cannot do it (or can it?). Jul 15, 2022 at 15:51
• I think that's right, Differences cannot do cyclic differences. (You'd think they'd an option.) BTW, I i didn't change the OP's question, just tags. The OP must have done that before I saw the question. Jul 15, 2022 at 17:26

Refactoring your code a bit:

ClearAll[ndim]
ndim[numberOfPoints_, dimensions_] := RandomReal[{0, 1}, {numberOfPoints, dimensions}]

ndim[5, 3]

(* Out: {{0.895729, 0.745554, 0.496111}, {0.136892, 0.303856, 0.978796},
{0.692973, 0.00699688, 0.750477}, {0.674827, 0.1062, 0.422643},
{0.107671, 0.501417, 0.916655}}*)


And a distance function between adjacent pairs:

distfun = BlockMap[Apply[EuclideanDistance], #, 2, 1] &;

distfun[ndim[10, 3]]

(* Out: {0.916786, 0.563845, 0.483837, 0.41518, 0.882357, 0.60575, 0.792918, 0.576871, 1.05629} *)

• Thank you, Marco. I have to solve this problem using lists, tables and dot products. Jul 14, 2022 at 16:08
• @mmfranco Those restrictions typically only happen when you are doing an assignment. If this is homework, you should include the relevant tag in the question. Jul 14, 2022 at 16:13
• Thank you, Marco. I have included the tag in the question. I have also edited it to show my second attempt, but it's taking extremely long and I'm wondering if this is normal? Jul 14, 2022 at 18:57