Kitonum

8520 Reputation

17 Badges

8 years, 316 days

MaplePrimes Activity


These are Posts that have been published by Kitonum

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 .

 

We assume that the radius of the outer stationary circle is  1. If we set the radius  x  of the inner stationary circle, all the other circles are uniquely determined by solving the system Sys.  Should be  x<=1/3 . If  x=1/3  then all the inner circles have a radius  1/3 . The following picture explains the meaning of symbols in the procedure Circles:

                                   

 

 

Circles:=proc(x)

local OO, O1, O2, O3, O4, O2x, O2y, O3x, O3y, OT, T1, T2, T3, s, t, dist, Sys, Sol, sol, y, u, v, z, C0, R0, P;

uses plottools, plots;

OO:=[0,0]: O1:=[x+y,0]: O2:=[O2x,O2y]: O3:=[O3x,O3y]: O4:=[-x-z,0]: OT:=[x+2*y-1,0]:

T1:=(O2*~y+O1*~u)/~(y+u): T2:=(O3*~u+O2*~v)/~(u+v): T3:=(O4*~v+O3*~z)/~(v+z):

solve({(T2-T1)[1]*(s-((T1+T2)/2)[1])+(T2-T1)[2]*(t-((T1+T2)/2)[2])=0, (T3-T2)[1]*(s-((T2+T3)/2)[1])+(T3-T2)[2]*(t-((T3+T2)/2)[2])=0}, {s,t}):

assign(%);

dist:=(A,B)->sqrt((B[1]-A[1])^2+(B[2]-A[2])^2):

Sys:={dist(O1,O2)^2=(y+u)^2, dist(OO,O2)^2=(x+u)^2, dist(O2,O3)^2=(u+v)^2, dist(OO,O3)^2=(x+v)^2, dist(O3,O4)^2=(z+v)^2, x+y+z=1, dist(O2,OT)^2=(1-u)^2, dist(O3,OT)^2=(1-v)^2};

Sol:=op~([allvalues([solve(Sys)])]);

sol:=select(i->is(eval(convert([y>0,u>0,v>0,z>0,O2y>0,x<=y,u<=y,v<=u,z<=v],`and`),i)), Sol)[];

assign(sol);

O1:=[x+y,0]: O2:=[O2x,O2y]: O3:=[O3x,O3y]: O4:=[-x-z,0]: OT:=[x+2*y-1,0]:

C0:=eval([s,t],sol);

R0:=eval(dist(T1,C0),sol):

P:=proc(phi)

local eq, r1, r, R, Ot, El, i, S, s, t, P1, P2;

uses plots,plottools;

eq:=1-dist([r*cos(s),r*sin(s)],OT)=r-x;

r1:=solve(eq,r);

r:=eval(r1,s=phi);

R[1]:=evalf(r-x);

Ot[1]:=evalf([r*cos(phi),r*sin(phi)]);

El:=plot([r1*cos(s),r1*sin(s),s=0..2*Pi],color="Green",thickness=3);

for i from 2 to 6 do

S:=[solve({1-dist(OT,[s,t])=dist(Ot[i-1],[s,t])-R[i-1], 1-dist(OT,[s,t])=dist(OO,[s,t])-x})];

P1:=eval([s,t],S[1]); P2:=eval([s,t],S[2]);

Ot[i]:=`if`(evalf(Ot[i-1][1]*P1[2]-Ot[i-1][2]*P1[1])>0,P1,P2);

R[i]:=dist(Ot[i],OO)-x;

od;

display(El,seq(disk(Ot[k],0.012),k=1..6),circle(C0,R0,color=gold,thickness=3),circle([x+2*y-1,0],1, color=blue,thickness=4), circle(OO,x, color=red,thickness=4), seq(circle(Ot[k],R[k], thickness=3),k=1..6), scaling=constrained, axes=none);

end proc:

animate(P,[phi], phi=0..Pi, frames=120);

end proc:  

 

Example of use (I got  x=0.22  just by measuring the ruler displayed original animation):

Circles(0.22);

                               

 

 

The curve on the following animation is an astroid (a special case of hypocycloid). See wiki for details. Hypocycloid procedure creates animation for any hypocycloid.  Parameters of the procedure: R is the radius of the outer circle, r is the radius of the inner circle.

Hypocycloid:=proc(R,r)

local A, B, f, g, F;

uses plots,plottools;

A:=circle(R,color=green,thickness=4):

B:=display(circle([R-r,0],r,color=red,thickness=4),line([R-r,0],[R,0],color=red,thickness=4)):

f:=t->plot([(R-r)*cos(s)+r*cos((R-r)/r*s),(R-r)*sin(s)-r*sin((R-r)/r*s),s=0..t],color=blue,thickness=4):

g:=t->rotate(rotate(B,-R/r*t,[R-r,0]),t):

F:=t->display(A,f(t),g(t),scaling=constrained):

animate(F,[t], t=0..2*Pi*denom(R/r), frames=90);

end proc:

 

Examples of use:

Hypocycloid(4,1); 

                                      

 

 

Hypocycloid(5,3);

                                      

 

 

 Круги.mw

1 2 3 4 5 6 7 Page 1 of 8