Kitonum

20696 Reputation

26 Badges

16 years, 144 days

MaplePrimes Activity


These are Posts that have been published by Kitonum

This post is the answer to this question.

The procedure named  IntOverDomain  finds a double integral over an arbitrary domain bounded by a non-selfintersecting piecewise smooth curve. The code of the procedure uses the well-known Green's theorem.

Each section in the border should be specified by a list in the following formats :    
1. If a section is given parametrically, then  [[f(t), g(t)], t=t1..t2]    
2. If several consecutive sections of the border or the entire border is a broken line, then it is sufficient to set vertices of this broken line  [ [x1,y1], [x2,y2], .., [xn,yn] ] (for the entire border should be  [xn,yn]=[x1,y1] ).

Required parameters of the procedure:  f  is an expression in variables  x  and  y , L  is the list of all the sections. The sublists of the list  L  must follow in the positive direction (counterclockwise).

The code of the procedure:

restart;
IntOverDomain := proc(f, L) 
local n, i, j, m, yk, yb, xk, xb, Q, p, P, var;
n:=nops(L);
Q:=int(f,x);  
for i from 1 to n do 
if type(L[i], listlist(algebraic)) then
m:=nops(L[i]);
for j from 1 to m-1 do
yk:=L[i,j+1,2]-L[i,j,2]; yb:=L[i,j,2];
xk:=L[i,j+1,1]-L[i,j,1]; xb:=L[i,j,1];
p[j]:=int(eval(Q*yk,[y=yk*t+yb,x=xk*t+xb]),t=0..1);
od;
P[i]:=add(p[j],j=1..m-1) else
var := lhs(L[i, 2]);
P[i]:=int(eval(Q*diff(L[i,1,2],var),[x=L[i,1,1],y=L[i,1,2]]),L[i,2]) fi;
od; 
add(P[i], i = 1 .. n); 
end proc:

 

Examples of use.

1. In the first example, we integrate over a quadrilateral:

with(plottools): with(plots):
f:=x^2+y^2:
display(polygon([[0,0],[3,0],[0,3],[1,1]], color="LightBlue"));  
# Visualization of the domain of integration
IntOverDomain(x^2+y^2, [[[0,0],[3,0],[0,3],[1,1],[0,0]]]);  # The value of integral

 

2. In the second example, some sections of the boundary of the domain are curved lines:

display(inequal({{y<=sqrt(x),y>=sin(Pi*x/3)/2,y<=3-x}, {y>=-2*x+3,y>=sqrt(x),y<=3-x}}, x=0..3,y=0..3, color="LightGreen", nolines), plot([[t,sqrt(t),t=0..1],[t,-2*t+3,t=0..1],[t,3-t,t=0..3],[t,sin(Pi*t/3)/2,t=0..3]], color=black, thickness=2));
f:=x^2+y^2: L:=[[[t,sin(Pi*t/3)/2],t=0..3],[[3,0],[0,3],[1,1]], [[t,sqrt(t)],t=1..0]]:
IntOverDomain(f, L);

 

3. If  f=1  then the procedure returns the area of the domain:

IntOverDomain(1, L);  # The area of the above domain
evalf(%);

 

IntOverDomain.mw

Edit.

In the creation of this animation the technique from here  was used.

 

                    

 

The code of this animation:

with(plots): with(plottools):
SmallHeart:=plot([1/20*sin(t)^3, 1/20*(13*cos(t)/16-5*cos(2*t)/16-2*cos(3*t)/16-cos(4*t)/16), t = 0 .. 2*Pi], color = "Red", thickness=3, filled):
F:=t->[sin(t)^3, 13*cos(t)/16-5*cos(2*t)/16-2*cos(3*t)/16-cos(4*t)/16]:
Gf:=display(translate(SmallHeart, 0,0.37)):
Gl:=display(translate(SmallHeart, 0,-1)):
G:=t->display(translate(SmallHeart, F(t)[])):
A:=display(seq(display(op([Gf,seq(G(-Pi/20*t), t=3..k),seq(G(Pi/20*t), t=3..k)]))$4,k=2..17),display(op([Gf,seq(G(-Pi/20*t), t=3..17),seq(G(Pi/20*t), t=3..17),Gl]))$30, insequence=true, size=[600,600]):
B:=animate(textplot,[[-0.6,0.25, "Happy"[1..round(n)]],color="Orange", font=[times,bolditalic,40], align=right],n=0..5,frames=18, paraminfo=false):
C:=animate(textplot,[[-0.2,0, "Valentine's"[1..round(n)]],color=green, font=[times,bolditalic,40], align=right],n=1..11,frames=35, paraminfo=false):
E:=animate(textplot,[[-0.3,-0.25, "Day!"[1..round(n)]],color="Blue", font=[times,bolditalic,40], align=right],n=1..4,frames=41, paraminfo=false):
T:=display([B, display(op([1,-1,1],B),C), display(op([1,-1,1],B),op([1,-1,1],C),E)], insequence=true):
K:=display(A, T, axes=none):
K;


The last frame of this animation:

display(op([1,-1],K), size=[600,600], axes=none);  # The last frame

                          

 

ValentinelDay.mw
 

Edit. The code was edited - the number of frames has been increased.

Suppose we have some simple animations. Our goal - to build a more complex animation, combining the original animations in different ways.
We show how to do it on the example of the three animations. The technique is general and can be applied to any number of animations.

Here are the three simple animations:

restart;
with(plots):
A:=animate(plot, [sin(x), x=-Pi..a, color=red, thickness=3], a=-Pi..Pi):
B:=animate(plot, [x^2-1, x=-2..a, thickness=3, color=green], a=-2..2): 
C:=animate(plot, [[4*cos(t),4*sin(t), t=0..a], color=blue, thickness=3], a=0..2*Pi):

 

In Example 1 all three animation executed simultaneously:

display([A, B, C], view=[-4..4,-4..4]);

                                

 

In Example 2, the same animation performed sequentially. Note that the previous animation disappears completely when the next one begins to execute:

display([A, B, C], insequence);

                                 

 

Below we show how to save the last frame of every previous animation into subsequent animations:

display([A, display(op([1,-1,1],A),B), display(op([1,-1,1],A),op([1,-1,1],B),C)], insequence);

                                 

 

Using this technique, we can anyhow combine the original animations. For example, in the following example at firstly animations   and  B  are executed simultaneously, afterwards C is executed:

display([display(A, B), display(op([1,-1,1],A),op([1,-1,1],B),C)], insequence);

                                     

 

The last example in 3D I have taken from here:

restart;
with(plots):
A:=animate(plot3d,[[2*cos(phi),2*sin(phi),z], z =0..a, phi=0..2*Pi, style=surface, color=red], a=0..5):
B:=animate(plot3d,[[(2+6/5*(z-5))*cos(phi), (2+6/5*(z-5))*sin(phi),z], z=5..a, phi=0..2*Pi, style=surface, color=blue], a=5..10):
C:=animate(plot3d,[[8*cos(phi),8*sin(phi),z], z =10..a, phi=0..2*Pi, style=surface, color=green], a=10..20):
display([A, display(op([1,-1,1],A),B), display(op([1,-1,1],A),op([1,-1,1],B),C)], insequence, scaling=constrained, axes=normal);

                        


 

AA.mw

   

 

The code for the animation:

L:=[[-0.12,2],[-0.14,0],[0.14,0],[0.12,2]]:
L1:=[[0.05,2],[4,1],[2,4],[3.5,3.5],[1,7],[2,6.5],[0,10]]:
A:=plot(L, color=brown, thickness=10):
B:=plot([op(L1),op(map(t->[-t[1],t[2]],ListTools:-Reverse(L1)))], color="Green", thickness=10):
C:=plottools:-polygon([op(L1),op(map(t->[-t[1],t[2]],ListTools:-Reverse(L1)))], color=green):
Tree:=plots:-display([A, B, C], scaling=constrained, axes=none):
T:=[[-3.2,-2, Happy, color=blue, font=[times,bold,30]], [0,-2,New, color=blue, font=[times,bold,30]], [2.5,-2,Year, color=blue, font=[times,bold,30]], [-5,-3.5, "&", color=yellow, font=[times,bold,30]],[-2.5,-3.5, Merry, color=red, font=[times,bold,30]], [2.3,-3.5, Christmas!, color=red, font=[times,bold,30]], [0,-5, "2017", color=cyan, font=[times,bold,36]]$5]:
F:=k->plottools:-homothety(Tree, k, [0,5]):
A:=plots:-animate(plots:-display, ['F'(k)], k=0..1, frames=60, paraminfo=false):
B:=plots:-animate(plots:-textplot,[T[1..round(i)]], i=0..nops(T), frames=60, paraminfo=false):
plots:-display(A, B, size=[500,550], scaling=constrained);


Christmas_Tree.mw

 Edit.

 

This post - this is a generalization of the question from  here .
Suppose we have  m  divisible objects that need to be divided equally between n persons, and so that the total number of parts (called  N  in the text of the procedure) after cutting should be a minimum. Cutting procedure exactly solves this problem. It can be proved that the estimate holds  n<=N<=n+m-1, and  N<n+m-1 if and only if there are several objects (< m), whose measures sum to be a multiple of the share (Obj in the text of the procedure).

In the attached file you can find also the text of the second procedure Cutting1, which is approximately solves the problem. The procedure Cutting1 is much faster than Cutting. But the results of their work are usually the same or Cutting procedure gives a slightly better result than Cutting1.

Required parameters of the procedure: L is the list of the measures of the objects to be cutted, n is the number of persons. The optional parameter  Name is a name or the list of names of the objects of L (if the latter then should be nops(L)=nops(Name) ).

 

Cutting:=proc(L::list(numeric), n::posint, Name::{name,list(name)}:=Object)

local m, n1, L1, L11, mes, Obj, It, M, N;

uses combinat, ListTools;

m:=nops(L); L1:=sort([seq([`if`(Name::name,Name||i,Name[i]),L[i]], i=1..m)], (a,b)->a[2]<=b[2]);

mes:=table(map(t->t[1]=t[2],L1));

Obj:=`+`(L[])/n;

It:=proc(L1, n)

local i, M, m1, S, n0, a, L2;

if nops(L1)=1 then return [[[L1[1,1],Obj]] $ n] fi;

if n=1 then return [L1] fi;

for i from 1 while `+`(seq(L1[k,2],k=1..i))<=Obj do

od;

M:=[seq(choose(L1,k)[], k=1..ceil(nops(L1)/2))];

S:=[];

for m1 in M while nops(S)=0 do n0:=`+`(seq(m1[k,2],k=1..nops(m1)))/Obj;

if type(n0,integer) then S:=m1 fi;

od;

if nops(S)=0 then

a:=Obj-`+`(seq(L1[k,2],k=1..i-1));

L2:=[[L1[i,1],L1[i,2]-a],seq(L1[k],k=i+1..nops(L1))];

 [[seq(L1[k], k=1..i-1),`if`(a=0,NULL,[L1[i,1],a])],It(L2,n-1)[]] else L2:=sort(convert(convert(L1,set) minus convert(S,set), list),(a,b)->a[2]<=b[2]);

[It(S,n0)[], It(L2,n-n0)[]] fi;

end proc;

M:=It(L1,n);

N:=add(nops(M[i]), i=1 ..nops(M));

Flatten(M, 1);

[Categorize((a,b)->a[1]=b[1],%)];

print(``);

print(cat(`Cutting scheme (total  `, N, `  parts):`) );

print(map(t->[seq(t[k,2]/`+`(seq(t[k,2],k=1..nops(t)))*t[1,1],k=1..nops(t))], %)[]);

print(``);

print(`Scheme of sharing out:`);

seq([Person||k,`+`(seq(M[k,i,2]/mes[M[k,i,1]]*M[k,i,1], i=1..nops(M[k])))],k=1..n);

end proc:

 

Examples of use.

First example from the link above:

Cutting([225,400,625], 4, Cake);  # 3 cakes must be equally divided by 4 persons

eval(%,[Cake1,Cake2,Cake3]=~[225,400,625]);  # Check

          

 

 

 

Second example (the same for 10 persons):

Cutting([225,400,625], 10, Cake);

        

 

 

Third example (7 identical apples should be divided between 12 persons):

Cutting([1 $ 7], 12, apple); 

 

 

Cutting.mw

 

 Edited:

1. Fixed a bug in the procedure Cutting  (I forgot sort the list  L2  in sub-procedure  It  if  nops(S)<>0 ).

2. Changes made to the sub-procedure  It  for the case if there are several objects (>1  and  < m), whose measures                     sum to be a multiple of the share  Obj .

 

2 3 4 5 6 7 8 Page 4 of 11