Inspired by the blog post Find a point in every region defined by a system of linear equations, I have come up with the following method to find a point inside each bounded region. The assumptions are:
Due to numerical instability, it seems, using floats, the coefficients of the equations of the lines are taken to be integers (they could also have been taken to be fractions, of course). Then the method goes like follows:
8, as originally posed in the above-mentioned blog post):
n := 8:
generator := rand(1000) - 500:
a := [seq(generator(),i=1..n)]:
b := [seq(generator(),i=1..n)]:
c := [seq(generator(),i=1..n)]:
eqs := {seq(a[i]*x + b[i]*y + c[i] = 0,i = 1..n)}:
dropNames := (s) -> [rhs(select(has,s,x)[]),rhs(select(has,s,y)[])]:
points := {seq(seq({i,j} =
dropNames(solve({eqs[i],eqs[j]},{x,y}))
,j = i+1..n),i = 1..n)};
pairs := {}:
for i1 in {$1..nops(points)} do
for i2 in {$1..nops(points)} minus {i1} do
# Check that the line segment joining the two points obey:
# 1. It is part of some line (cond1)
# 2. It is not crossed by any line (cond2)
x1,y1 := rhs(points[i1])[1],rhs(points[i1])[2];
x2,y2 := rhs(points[i2])[1],rhs(points[i2])[2];
l1 := [seq](eval(lhs(eqs[j]),{x = x1,y = y1}),j = 1..nops(eqs));
l2 := [seq](eval(lhs(eqs[j]),{x = x2,y = y2}),j = 1..nops(eqs));
cond1 := evalb(lhs(points[i1]) intersect lhs(points[i2]) <> {});
cond2 := not member(true,
{seq}(evalb(l1[j] * l2[j] < 0),j = 1..nops(eqs))
);
if cond1 and cond2 then pairs := pairs union {[i1,i2]} end if
end do
end do:
pairs;
triples := {}:
for i1 in {$1..nops(pairs)} do
for i2 in {$1..nops(pairs)} minus {i1} do
v1 := rhs(points[pairs[i1][2]]) - rhs(points[pairs[i1][1]]);
v2 := rhs(points[pairs[i2][2]]) - rhs(points[pairs[i2][1]]);
if
# Check for common middle point, and 'convexity'
evalb(pairs[i1][2] = pairs[i2][1]) and
evalb(v1[1] * v2[2] - v1[2] * v2[1] > 0)
then triples := triples union {[pairs[i1][],pairs[i2][2]]}
end if
end do
end do:
triples;
evolvePath := proc(path) local triple; # Closed path if member([path[-1],path[1]],pairs) then path # Not closed path else map( x -> `if`(path[-2..-1] = x[1..2],[path[],x[3]],NULL), triples )[]; end if end proc: evolvedPaths := proc(paths) local pathsEvolved; pathsEvolved := map(evolvePath,paths); `if`(pathsEvolved <> paths, evolvedPaths(pathsEvolved),pathsEvolved ) end proc: convexPaths := evolvedPaths(triples);
polygons := map(convert,map( x -> `if`(member([x[-2],x[-1],x[1]],triples),x,NULL),convexPaths ),set);
centers := map(p -> `+`(map(i -> rhs(points[i]),p)[]) / nops(p),polygons);
A consistency check for any given n: According to Israel the number of regions, bounded and unbounded, is given by 1/2*n^2 + 1/2*n + 1, so the number of bounded regions is given by 1/2*n^2 - 3/2*n + 1, subtracting 2*n. This should equal the number of polygons, as obtained above.
30 min 6 sec ago
34 min 46 sec ago
6 hours 56 min ago
7 hours 25 min ago
7 hours 48 min ago
8 hours 33 min ago
9 hours 15 min ago
21 hours 57 min ago
22 hours 39 min ago
1 day 1 hour ago