Polygons of the matches

January 31 2013 Kitonum 7329

We assume that the length of a match is 1, then the perimeter of a polygon is equal to the number of matches N. If a match can be located at arbitrary angles to each other, then at a given perimeter of the area can take on any value between zero and the area of a regular polygon (for even number of matches) . For an odd number of matches the lower bound equals to the area of an equilateral triangle of side 1. For any given area within these boundaries will be infinitely many solutions.
In my opinion more interesting variant of the problem, when a match can be located only on the horizontals and verticals. Obviously, in this case it will be only a finite number of solutions. Polygons procedure finds all these solutions. Formal arguments: N - perimeter (number of matches), and S - the area of a polygon.

The procedure returns the number of polygons with given perimeter and area and you can see a list of coordinates of the vertices of the polygons (global variable T). Unfortunately, this list may to contain symmetrical polygons and polygons obtained from each other by parallel translation. Therefore, the procedure can be improved with a view to getting rid from this.

Polygons:=proc(N, S)

local Area, n, m, It, rk, L, U, T0, f, T1;

global T;

uses ListTools;

if type(N, odd)  or  SN^2/16  then

print(`No solutions`) else



local M;

M:=[op(L), L[1]];

add(M[i,1]*M[i+1,2]-M[i+1,1]*M[i,2], i=1..nops(L))/2;

end proc:


n:=(N-2)/2; m:=floor((n+1)/2);



local j, k, r, M, s;

j:=0; k:=nops(K[1]);


for r in K do

if r[k]=[0,0] then M:=[[0,1], [1,0]] elif

r[k]=[0,m] then M:=[[0,m-1], [1,m]] elif

r[k]=[n,0] then M:=[[n-1,0], [n,1]] elif

r[k] in {seq([i, n+1-i], i=m..n)} then M:=[[r[k,1]-1,r[k,2]], [r[k,1],r[k,2]-1]] elif

r[k,1]=0 and r[k,2]>0 and r[k,2]

r[k,2]=m and r[k,1]>0 and r[k,1]

r[k,2]=0 and r[k,1]>0 and r[k,1]

M:=[[r[k,1]-1,r[k,2]], [r[k,1],r[k,2]+1], [r[k,1]+1,r[k,2]], [r[k,1],r[k,2]-1]]; fi;


rk := r[1..k-1];

j := j+1;

s[j] := seq(`if`(member(p,rk), NULL, [op(r),p]), p = M);




[seq(s[i], i=1..j)];


end proc;


L:=[seq([[0,i]], i=0..m)];



T0:=[seq(`if`(((p[1,1]=p[N,1] and abs(p[N,2]-p[1,2])=1) or (p[1,2]=p[N,2] and abs(p[N,1]-p[1,1])=1)) and abs(Area(p))=S, p, NULL),  p = U)];


f:=(x,y)->convert(x, set)=convert(y, set);

T1:=[Categorize(f, T0)];

T:=[seq(T1[i,1], i=1..nops(T1))]: # List of all the polygons


nops(T);  # Number of all the polygons




end proc:


Visual  procedure produces the visualization of the resulting list  T  or it's part. Formal arguments: K - a list of polygons for visualization, m - the number of polygons in each row.

Visual:=proc(K, m)

local n, K1, i, L, d, R, B, A;


K1:=[seq([op(K[i]),K[i,1]], i=1..n)]:

 for i to n do

 L[i]:=plottools[curve](K1[i], color=yellow, thickness=5):

 d[i]:=plots[pointplot](K[i], symbol=solidcircle,symbolsize=15, color=brown):

 R[i]:=plottools[polygon](K[i], color = grey):

 B[i]:=plots[display](L[i], R[i],d[i]):


A := seq(plots[display](B[k], axes = none, scaling = constrained), k = 1 .. n), seq(plots[display](plots[display](plot([[0,0]]), axes=none, scaling=constrained), axes=none, scaling=constrained), k=1..m*ceil(n/m)-n):

 Matrix(ceil(n/m), m, [A]):


end proc:


N:=12: S:=6:
Polygons(N, S);



K:=T[1 .. 9]:
Visual(K, 3);

Please Wait...