3
$\begingroup$

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

$\endgroup$
3
  • 1
    $\begingroup$ "...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. $\endgroup$ Jul 14, 2022 at 15:05
  • $\begingroup$ I need to find the distance by creating lists from tables. $\endgroup$
    – mmfranco
    Jul 14, 2022 at 15:18
  • $\begingroup$ Then, why couldn't you do Mean[EuclideanDistance @@@ Partition[dsqr[n], 2, 1, 1]]? $\endgroup$ Jul 14, 2022 at 15:28

2 Answers 2

3
$\begingroup$

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[NDSolve`FEM`MapThreadDot[#, #] &[
      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...)

$\endgroup$
4
  • $\begingroup$ Thank you, Henrik. I have added to my question the code for my second attempt. $\endgroup$
    – mmfranco
    Jul 14, 2022 at 18:59
  • $\begingroup$ FWIW, Differences[a] saves a modest amount time over Subtract[..]. $\endgroup$
    – Michael E2
    Jul 15, 2022 at 14:57
  • $\begingroup$ 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?). $\endgroup$ Jul 15, 2022 at 15:51
  • 1
    $\begingroup$ 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. $\endgroup$
    – Michael E2
    Jul 15, 2022 at 17:26
1
$\begingroup$

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} *)
$\endgroup$
3
  • $\begingroup$ Thank you, Marco. I have to solve this problem using lists, tables and dot products. $\endgroup$
    – mmfranco
    Jul 14, 2022 at 16:08
  • 1
    $\begingroup$ @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. $\endgroup$
    – MarcoB
    Jul 14, 2022 at 16:13
  • $\begingroup$ 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? $\endgroup$
    – mmfranco
    Jul 14, 2022 at 18:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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