Finding all the lines that can be defined a set of points

Question

Input ten Points, calculate every possible straight line from each possible pair of points and check if any of the other points are on the lines.

Is something like this possible in mathematica? and if so how?

I have to create a script that can take in up to ten points (x, y) and automatically generates a straight line between every combination of two points and then checks, for each line, if any of the remaining points points are on this straight line.

Can anyone help me?

Answer 1

ClearAll[f2]
f2 = RegionDimension[Triangle @ #] <= 1 &;

Using triples and f from Henrik's answer, f2 gives the same result as f

f2 /@ triples == f /@ triples

True

and, to my surprise, it is faster:

f2 /@ triples ; // RepeatedTiming // First

0.0065

f /@ triples ; // RepeatedTiming // First

0.029

Answer 2

Some general tips:

Consider the area of a triangle with points $(x_1,y_1)$, $(x_2,y_2)$ and $(x_3,y_3)$. This area is $0$ if all points fall on a line.

The area of a triangle is given by (see here):

$A(x_1,x_2,x_3,y_1,y_2,y_3)= | \frac{x_1(y_2-y_3) + x_2 (y_3-y_1) + x_3 (y_1-y_2)}{2}|$

Note that this expression looks similar to that of the determinant of a matrix, which in turn relates to the rank of the matrix (see here). This links to the answer provided by @HenrikSchumacher.

Answer 3

I have used $n=5$ to keep the table small. You can bump it up to 10.

SeedRandom[10];
n = 5;
pts = RandomReal[{-4, 4}, {n, 2}];
lines = Line /@ Subsets[pts, {2}];
Join[{Rule @@ Identity @@ #},  RegionMember[#, pts]] & /@ lines;
TableForm[%, TableHeadings -> {None, Join[{""}, pts]}]

To visualize it

Show[ListPlot[Callout /@ pts, PlotTheme -> "Business"], Graphics[lines]]

Answer 4

An example set of points in $\mathbb{R}^3$.

p = Tuples[{-1, 0, 1}, 3];
n = Length[p];

The list of all point triples:

triples = Subsets[p, {3}];

A function that checks whether a list x of k = Length[x] points spans an affine space of dimension less than k-1:

f = Function[x, MatrixRank[x[[2 ;;]] - ConstantArray[x[[1]], Length[x] - 1]] < Length[x] - 1 ];

Applying this function to all point triples:

f /@ triples