In the excellent book by W.G. Chinn, N.E. Steenrod "First Concepts of Topology" the theorem is proved which states that any bounded planar region can be cut into 4 regions of equal area by 2 perpendicular cuts (the pancake problem). This is an existence theorem which does not provide any way to find these cuts. In this post I made an attempt to find such cuts for any convex region on the plane bounded by a piecewise smooth self-non-intersecting curve.
The Into_4_Equal_Areas procedure returns a list of coordinates of 5 points: the first 4 points are the endpoints of the cutting segments, the fifth point is the intersection point of these segments. This procedure significantly uses my old procedure Area , which can be found in detail at the link  https://mapleprimes.com/posts/145922-Perimeter-Area-And-Visualization-Of-A-Plane-Figure-  . The formal argument of the Into_4_Equal_Areas procedure is a list  L specifying the boundary of the region to be cut. When specifying  L, the boundary can be passed clockwise or counterclockwise, but it is necessary that the parameter t (when specifying each link) should go in ascending order. This can always be achieved by replacing  t  with  -t  if necessary. The Pic procedure draws a picture of the source region and cutting segments. For ease of use, the code for the  Area  procedure is also provided. It is also worth noting that the procedure also works for "not too" non-convex regions (see examples below).

restart;
Area := proc(L) 
local i, var, e, e1, e2, P; 
for i to nops(L) do 
if type(L[i], listlist(algebraic)) then 
P[i] := (1/2)*add(L[i, j, 1]*L[i, j+1, 2]-L[i, j, 2]*L[i, j+1, 1], j = 1 .. nops(L[i])-1) else 
var := lhs(L[i, 2]); 
if type(L[i, 1], algebraic) then e := L[i, 1]; 
if nops(L[i]) = 3 then P[i] := (1/2)*(int(e^2, L[i, 2])) else 
if var = y then P[i] := (1/2)*simplify(int(e-var*(diff(e, var)), L[i, 2])) else 
P[i] := (1/2)*simplify(int(var*(diff(e, var))-e, L[i, 2])) end if end if else e1 := L[i, 1, 1]; e2 := L[i, 1, 2]; 
P[i] := (1/2)*simplify(int(e1*(diff(e2, var))-e2*(diff(e1, var)), L[i, 2])) end if end if end do; 
abs(add(P[i], i = 1 .. nops(L))); 
end proc:

Into_4_Equal_Areas:=proc(L::list,N::symbol:='OneSolution', eps::numeric:=0)
local D, n, c, L1, L2, L3, f, L0, i, j, k, m, A, B, C, P, S, sol, Sol;
f:=(X,Y)->expand((y-X[2])*(Y[1]-X[1])-(x-X[1])*(Y[2]-X[2]));
L0:=map(p->`if`(type(p,listlist),[[p[1,1]+t*(p[2]-p[1])[1],p[1,2]+t*(p[2]-p[1])[2]],t=0..1],p), L);
S:=Area(L); c:=0;
n:=nops(L);
for i from 1 to n do
for j from i to n do
for k from j to n do
for m from k to n do
if not ((nops({i,j,k})=1 and type(L[i],listlist)) or (nops({j,k,m})=1 and type(L[j],listlist)))then
A:=convert(subs(t=t1,L0[i,1]),Vector): 
B:=convert(subs(t=t2,L0[j,1]),Vector):
C:=convert(subs(t=t3,L0[k,1]),Vector): 
D:=convert(subs(t=t4,L0[m,1]),Vector):
P:=eval([x,y], solve({f(A,C),f(B,D)},{x,y})):
L1:=`if`(j=i,[subsop([2,2]=t1..t2,L0[i]),[convert(B,list),P],[P,convert(A,list)]],`if`(j=i+1,[subsop([2,2]=t1..op([2,2,2],L0[i]),L0[i]),subsop([2,2]=op([2,2,1],L0[j])..t2,L0[j]),[convert(B,list),P],[P,convert(A,list)]], [subsop([2,2]=t1..op([2,2,2],L0[i]),L0[i]),L0[i+1..j-1][],subsop([2,2]=op([2,2,1],L0[j])..t2,L0[j]),[convert(B,list),P],[P,convert(A,list)]])):
L2:=`if`(k=j,[subsop([2,2]=t2..t3,L0[j]),[convert(C,list),P],[P,convert(B,list)]],`if`(k=j+1,[subsop([2,2]=t2..op([2,2,2],L0[j]),L0[j]),subsop([2,2]=op([2,2,1],L0[k])..t3,L0[k]),[convert(C,list),P],[P,convert(B,list)]], [subsop([2,2]=t2..op([2,2,2],L0[j]),L0[j]),L0[j+1..k-1][],subsop([2,2]=op([2,2,1],L0[k])..t3,L0[k]),[convert(C,list),P],[P,convert(B,list)]])):
L3:=`if`(m=k,[subsop([2,2]=t3..t4,L0[k]),[convert(D,list),P],[P,convert(C,list)]],`if`(m=k+1,[subsop([2,2]=t3..op([2,2,2],L0[k]),L0[k]),subsop([2,2]=op([2,2,1],L0[m])..t4,L0[m]),[convert(D,list),P],[P,convert(C,list)]], [subsop([2,2]=t3..op([2,2,2],L0[k]),L0[k]),L0[k+1..m-1][],subsop([2,2]=op([2,2,1],L0[m])..t4,L0[m]),[convert(D,list),P],[P,convert(C,list)]])):
sol:=fsolve({Area(L1)-S/4,Area(L2)-S/4,Area(L3)-S/4,LinearAlgebra:-DotProduct(D-B,C-A, conjugate=false)},{t1=op([2,2,1],L0[i])-eps..op([2,2,2],L0[i])+eps,t2=op([2,2,1],L0[j])-eps..op([2,2,2],L0[j])+eps,t3=op([2,2,1],L0[k])-eps..op([2,2,2],L0[k])+eps,t4=op([2,2,1],L0[m])-eps..op([2,2,2],L0[m])+eps}) assuming real:
if type(sol,set(`=`)) then if N='OneSolution' then return convert~(eval([A,B,C,D,P],sol),list) else c:=c+1; Sol[c]:=convert~(eval([A,B,C,D,P],sol),list) fi;
 fi; fi;
od: od: od: od:
convert(Sol,list);
end proc:

Pic:=proc(L,Sol)
local P1, P2, T;
uses plots, plottools;
P1:=seq(`if`(type(s,listlist),line(s[],color=blue, thickness=2),plot([s[1][],s[2]],color=blue, thickness=2)),s=L):
P2:=line(Sol[1],Sol[3],color=red, thickness=2), line(Sol[2],Sol[4],color=red):
T:=textplot([[Sol[1][],"A"],[Sol[2][],"B"],[Sol[3][],"C"],[Sol[4][],"D"],[Sol[5][],"P"]], font=[times,18], align=[left,above]);
display(P1,P2,T, scaling=constrained, size=[800,500], axes=none);
end proc: 

Examples of use:

L:=[[[0,0],[1,4]],[[1,4],[6,7]],[[6,7],[12,0]],[[12,0],[0,0]]]:
Sol:=Into_4_Equal_Areas(L);
Pic(L, Sol);

# Check (areas of all 4 regions)
Area([[L[1,1],Sol[4],Sol[5],Sol[1],L[1,1]]]),
Area([[Sol[4],Sol[5],Sol[3],L[4,1],Sol[4]]]),
Area([[Sol[5],Sol[2],L[3,1],Sol[3],Sol[5]]]),
Area([[Sol[5],Sol[2],L[1,2],Sol[1],Sol[5]]]);

L:=[[[1+cos(-t),1+sin(-t)],t=-3*Pi/2..-Pi],[[0,1],[-1,0]],[[cos(t),sin(t)],t=Pi..2*Pi]]:
Sol:=Into_4_Equal_Areas(L);
Pic(L,Sol);

# The boundary is the Archimedes spiral and the arc of a circle

L:=[[[t*cos(t),t*sin(t)],t=0..2*Pi],[[Pi+5*cos(-t),sqrt(25-Pi^2)+5*sin(-t)],t=arccos(Pi/5)..Pi-arccos(Pi/5)]]:
Sol:=evalf(Into_4_Equal_Areas(L));
Pic(L,Sol);

L:=[[[0,0],[2,0]],[[2,0],[1,sqrt(3)]],[[1,sqrt(3)],[0,0]]]:
Sol:=evalf[5](Into_4_Equal_Areas(L, AllSolutions, 0.1)); # All 3 solutions
plots:-display(<Pic(L, Sol[1]) | Pic(L, Sol[2])  | Pic(L, Sol[3])>, size=[300,300]);  

L:=[[[-t,-sin(-t)],t=-5*Pi/4..0],[[cos(t),sin(t)-1],t=Pi/2..3*Pi/2],[[t,cos(t)-3],t=0..3*Pi/2],[[3*Pi/2,-3],[5*Pi/4,sqrt(2)/2]]]:
Sol:=evalf(Into_4_Equal_Areas(L));
Pic(L,Sol);

More examples can be found in the attached file.

4_Equal_Area1.mw

[Edit]. The post has been edited. One inaccuracy in the code has been corrected, which could sometimes lead to errors. Two options have been added to the code of Into_4_Equal_Areas procedure. The first option is the formal argument  N . If N=OneSolution  (by default), the procedure returns one solution. If  N=AllSolutions , the procedure returns all solutions that it can find. The  eps  option has also been added (by default, eps=0). It is advisable to use it when we are looking for all solutions, and the ends of the cutting segments fall on the boundaries of intervals (this option slightly expands the boundaries of intervals, otherwise the  fsolve  command sometimes misses solutions). Two new examples have also been added.

Good afternoon.

I have a differential equation of non-integer degree and would like to know if it is possible to express a solution in terms of elementary or special-functions for certain values of the exponent, n>0.

For this equation, Maple provides an analytical solution for the exponent values n=0 and n=1, otherwise, there is no solution returned. I am particularly interested in the cases where n=1/2, 3/2, 2, 5/2, and 3

I am hoping that someone can help me resolve this - if a closed-form solution is not possible, then a numerical solution would also be welcome.

I have provided the details in the attached worksheet.

Thanks for reading!

MaplePrimes_Dec_19.mw

is(abs(x)=max(x,-x)) assuming real;

#  FAIL

I wonder if this will work in newer versions of Maple?

Hi,
How can I simplify this relation(See uploaded .mw file)?
For example, the second term is simplified as: 

deltae*(1-phi0/(kappa-3/2))^(-kappa+1/2)+(1/2)*deltab*(1-sqrt(2)*sqrt(1/(m*ub^2))*sqrt(-phi0));

di1.mw

How to insert a file inside another file, creating a session, without equations with the same name conflicting?

Hi,
I have an equation and I want to solve it parametrically to find x , but I couldn't do that with "solve" command. (I know x should be  real and positive). What should I do?
Root_of.mw

Hi. 

I am trying to solve a polynomial equation but the structure leads Maple to return a trivial solution and the other solutions are given as a RootOf expression. The equation involves a single variable, x, that is raised to a power, b and a multiplier, a (both are positive-valued). Please see attached worksheet.

I have not encountered this before and I cannot find a way to get to an explicit solution. Perhaps it is not possible (?).

Does anybody know how to deal with this? 

Thanks in advance ...

Roots_of_a_Polynomial_MaplePrimes.mw 

Good day, all.

I would like to explore the structure of the discrete modified form of the logistic equation.

In particular, I wish to plot the logistic-map to investigate the bifurcations of the system.

Is there a routine available in Maple that I can use?

I would like to consider the standard logistic equation with the inclusion of a shape parameter, m, introduced as a power law.

That is:

f(x) = a*x*(1-x^m)

where a > 0 denotes the growth rate, and m > 0  is a shape parameter. I wish to fix the value of a and take m to be the bifurcation parameter (so the logistic map would show m versus x for any given a).

Please note: The standard logistic equation (in discrete form) is given by f(x) = a*x*(1-x)

I would be grateful for any advice and support you can provide and I thank you for taking the time to read this.

Drear freinds,

I want to simplify f (a long experssion) in the form of f2. How to determine M1^2 and M0^2?

f1.mw

Hi,
How can I remove the mentioned error in attached worksheet?

s1.mw

Dear sir,

In the given problem, eta = 0 to 20, I want the table value of eta for a step size of 1000 (0 to 20 in thousand parts).

i have calculated only for one value, zero

Download Demo_paper_work.mw

Consider the equation  (2^x)*(27^(1/x)) = 24  for which we need to find the exact values ​​of its real roots. This is not difficult to solve by hand if you first take the logarithm of this equation to any base, after which the problem is reduced to solving a quadratic equation. But the  solve  command fails to solve this equation and returns the result in RootOf form. The problem is solved if we first ask Maple to take the logarithm of the equation. I wonder if the latest versions of Maple also do not directly address the problem?

restart;
Eq:=2^x*27^(1/x)=24:
solve(Eq, x, explicit);

map(ln, Eq); # Taking the logarithm of the equation
solve(%, x);
simplify({%}); # The final result

How to get the animation graphs for eta =0..10

Download ode_plots_animation_graphs.mw

i need like this demo plot  

I want like this plots here two phase are there boundary is -2 to0 and 0 to 2

f(±2)=0,g(±2)=0,f(0)=1,h(±2)=1,H(±2)=1

Is it possible to simplify the following relatively simple expression  (10*(5+sqrt(41)))/(sqrt(70+10*sqrt(41))*sqrt(130+10*sqrt(41)))  using 1-2 standard commands  simplify , combine, radnormal  and so on?   I was unable to do this in Maple 2018. Maybe newer versions of Maple will be able to handle this. I managed to simplify it in 3 steps:

expr:=(10*(5+sqrt(41)))/(sqrt(70+10*sqrt(41))*sqrt(130+10*sqrt(41)));
sqrt(simplify(expr^2));