:

## Both area and perimeter in half

In this post an interesting geometric problem is solved: for an arbitrary convex polygon, find a straight line that divides both the area and the perimeter in half. The following results on this problem are well known:
1. For any convex polygon there is such a straight line.
2. For any convex polygon into which a circle can be inscribed, in particular for any triangle, the desired line must pass through the center of the inscribed circle.
3. For a triangle, the number of solutions can be 1, 2, or 3.
4. If the polygon has symmetry with respect to a point, then any straight line passing through this point is a solution.

The procedure called  InHalf  (the code below) symbolically solves this problem. The formal parameter of the procedure is the list of coordinates of the vertices of a convex polygon (vertices must be passed opposite or clockwise). The procedure returns all solutions in the form of a list of pairs of points, lying on the perimeter of the polygon, that are the ends of segments that implement the desired dividing.

 > restart;
 > InHalf:=proc(V::listlist) local L, n, a, b, M, N, i, j, P, Q, L1, L2, Area, Area1, Area2, Perimeter, Perimeter1, Perimeter2, sol, m, k, Sol; uses LinearAlgebra, ListTools; L:=map(convert,[V[],V[1]],rational); n:=nops(L)-1; a:=<(V[2]-V[1])[1],(V[2]-V[1])[2],0>; b:=<(V[n]-V[1])[1],(V[n]-V[1])[2],0>; if is(CrossProduct(a,b)[3]<0) then L:=Reverse(L) fi; M:=[seq([L[i],L[i+1]], i=1..n)]: N:=0; for i from 1 to n-1 do for j from i+1 to n do P:=map(t->t*(1-s),M[i,1])+map(t->t*s,M[i,2]); Q:=map(s->s*(1-t),M[j,1])+map(s->s*t,M[j,2]); L1:=[P,L[i+1..j][],Q,P]; L2:=[Q,L[j+1..-1][],L[1..i][],P,Q]; Area:=L->(1/2)*add(L[k, 1]*L[k+1, 2]-L[k, 2]*L[k+1, 1], k = 1 .. nops(L)-1); Area1:=Area(L1); Area2:=Area(L2); Perimeter:=L->add(sqrt((L[k,1]-L[k+1,1])^2+(L[k,2]-L[k+1,2])^2), k=1..nops(L)-2); Perimeter1:=Perimeter(L1); Perimeter2:=Perimeter(L2); sol:=[solve({Area1=Area2,Perimeter1=Perimeter2,s>=0,s<1,t>=0,t<1}, {s,t}, explicit)] assuming real; if sol<>[] then m:=nops(sol); for k from 1 to m do N:=N+1; if nops(sol[k])=2 then Sol[N]:=simplify(eval([P,Q],sol[k])) else Sol[N]:=simplify(eval([P,Q],s=t)) fi; od; fi; od; od; Sol:=convert(Sol, list); `if`(indets(Sol)={},Sol,op([Sol,t>=0 and t<1])); end proc:

Examples of use

 > # For the Pythagorean triangle with sides 3, 4, 5, we have a unique solution L:=[[4,3],[4,0],[0,0]]: P:=InHalf(L); plots:-display(plot([L[],L[1]], color=green, thickness=3), plot(P,  color=red), scaling=constrained);
 > # For an isosceles right triangle, there are 3 solutions. We see that all the cuts pass through the center of the inscribed circle L:=[[0,0],[4,0],[4,4]]: InHalf(L); P:=InHalf(L); r:=(4+4-4*sqrt(2))/2: a:=4-r: b:=r: plots:-display(plot([L[],L[1]], color=green, thickness=3), plot(P,  color=red), plot([r*cos(t)+a,r*sin(t)+b, t=0..2*Pi], color=blue), scaling=constrained);
 > # There are 3 solutions for the quadrilateral below L:=[[0,0],[4.5,0],[4,3],[0,2]]: P:=InHalf(L); plots:-display(plot([L[],L[1]], color=green, thickness=3), plot(P,  color=red), scaling=constrained);
 > # There are infinitely many solutions for a polygon with a center of symmetry. Any cut through the center solves the problem. The picture shows 2 solutions. L:=[[1,0],[1+2*sqrt(3),2],[2*sqrt(3),sqrt(3)+2],[0,sqrt(3)]]: P:=InHalf(L); plots:-display(plot([L[],L[1]], color=green, thickness=3), plot(eval(P[1],t=1/3),  color=red), scaling=constrained);
 >