Kitonum

20666 Reputation

26 Badges

16 years, 125 days

MaplePrimes Activity


These are answers submitted by Kitonum

You have two basic elements g and g1. All the rest are obtained from them by  translate command.

g := plottools[curve]([seq([cos(2*Pi*i*(1/3)), sin(2*Pi*i*(1/3))], i = 0 .. 3)], color = brown, thickness = 5):

g1 := plottools[rotate](g, (1/3)*Pi, [cos(2*Pi*(1/3)), sin(2*Pi*(1/3))]):

plots[display](g, g1, scaling = constrained);

 

Different variant:

g := plottools[curve]([seq([cos(Pi/2+2*Pi*i*(1/3)), sin(Pi/2+2*Pi*i*(1/3))], i = 0 .. 3)], color = brown, thickness = 5):

g1 := plottools[rotate](g, (1/3)*Pi, [0, 1]):

plots[display](g, g1, scaling = constrained);

The procedure Hexlat builds a hexagonal lattice consisting of regular hexagons. Formal arguments: the first two numbers (m and nspecify the size of the lattice, the list L specifies the color of the borders and interior, the last number t specifies the thickness of the borders.

Code of the procedure:

Hexlat:=proc(m, n, L, t)

local g,g1,p,p1,A,A1,B,B1,C,C1;

g:=plottools[curve]([seq([cos(Pi*i/3),sin(Pi*i/3)],i=0..6)],color=L[1],thickness=t);

g1:=plottools[translate](g,3/2,-sqrt(3)/2);

p:=plottools[polygon]([seq([cos(Pi*i/3),sin(Pi*i/3)],i=1..6)],color=L[2]);

p1:=plottools[translate](p,3/2,-sqrt(3)/2);

A:=seq(plottools[translate](g,0,sqrt(3)*k),k=0..m-1);

A1:=seq(plottools[translate](g1,0,sqrt(3)*k),k=0..m-1);

B:=seq(plottools[translate](p,0,sqrt(3)*k),k=0..m-1);

B1:=seq(plottools[translate](p1,0,sqrt(3)*k),k=0..m-1);

C:=plots[display](A,B,A1,B1,scaling=constrained);

C1:=plots[display](A,B,scaling=constrained);

if is(n,even) then print(plots[display](seq(plottools[translate](C,3*k,0),k=0..(n-2)/2),scaling=constrained,axes=none)) fi;

if is(n,odd) then plots[display](seq(plottools[translate](C,3*k,0),k=0..(n-3)/2), plottools[translate](C1,3*(n-1)/2,0),scaling=constrained,axes=none) fi;

end proc:

 

An example:

Hexlat(7,11,[brown,yellow],5);

You need at each step of the loop for all new objects to assign new names, , like this:

restart:

k := 0:

ode := diff(U(t), t) = -((0.01/365)+((0.01/365)*U(t)))*U(t):

ic[0] := U(365*k) = 1000:

sol[0] := dsolve({ic[0], ode}, U(t), numeric):

sigma := 1.5:                            

for k to 10 do

  tk:=365*k:  

  V := rhs(sol[k-1](tk)[2]):

  ic[k] := U(tk) = sigma*V:

  sol[k] := dsolve({ic[k], ode}, U(t), numeric):

end do:

Plotting the first five decisions, from the points corresponding to the initial conditions:

A:=seq(plots[odeplot](sol[i],[t,U(t)],365*i..2000,thickness=2,color=[red,blue,green,brown,black][i+1]),i=0..4):

plots[display](A);

Your problem 3 can be easily solved if we use the geometric properties of the graph of a cubic polynomial.

Code of solution:

f:=x->x^3 -3*m*x^2 +3*(m^2 - 1)*x -m^2 +1:

S:=[solve(D(f)(x)=0, x)]:

f1:=%[1]: f2:=%[2]:

op(simplify([solve({f(0)<0, min(S)>0, f(min(S))>0, f(max(S))<0})]));

{m<1+sqrt(2), sqrt(3)<m}

 

The idea of ​​the solution is clearly seen from the figure:

 

 

Due to the singularity at the origin  the decision for x>0 can not be extended uniquely to the left of 0. So if you want to get the suitable solution, then you need to "glue" it by two solutions: for x <0 and for x> 0:

eq:=x*diff(y(x),x)=2*y(x):

ini1:=[y(-1)=2]:  ini2:= [y(1)=2]:

A:=DEtools[DEplot](eq,y(x),x=-3..0,y=-1..5,[ini1]):

B:=DEtools[DEplot](eq,y(x),x=0..3,y=-1..5,[ini2]):

plots[display](A,B);

minimize(3*x^2+2*m*x+2*m^2-3*m-6, 1<= x, m=-infinity..infinity);

-25/8

See an example of the cyclic program, which solves the differential equation by the simplest variant of Euler's method. For comparison, on the same plot displayed the resulting solution and the solution by dsolve command.

Eq:=diff(x(t),t)=x(t)^2+t^2: inc:=x(0)=0:

L:=[[0,0]]:

for i to 10 do

a:=L[nops(L)]: L:=[op(L), [i/10, a[2]+0.1*subs(x(t)=a[2],t=(i-1)/10,rhs(Eq))]]:

od:

evalf[3](L);

M:=rhs(dsolve({diff(x(t),t)=x(t)^2+t^2, x(0)=0})):

plot([L,M], t=0..1, color=[red,blue], thickness=2);

Ax:=t->cos(5*t): Ay:=t->0: Bx:=t->-cos(5*t)/2: By:=t->3*cos(5*t)/2:

S:=seq(plots[arrow]([Ax(i*Pi/72),Ay(i*Pi/72)],color=blue),i=0..72):

T:=seq(plots[arrow]([Bx(i*Pi/72),By(i*Pi/72)],color=green),i=0..72):

U:=seq(plots[display]([S[i],T[i]]),i=1..73):

plots[display](U,view=[-2..2,-2..2],insequence=true);

You must assign  z  as a function, such as in an example

restart:

dsolve({diff(z(t),t) = 2*t-1, z(0) = 1});

z:= unapply(rhs(%), t);  

z(60);

a:= 1: b:= 1/sqrt(3):

for n to 2010 do

c:= simplify((a + b)/(1-a*b)):  a:=b:  b:=c:

od:

c;

Brute force computation shows that there are no solutions. Explanation of code: firstly founded a list of matrices  H  of 0 and 1, satisfying the first condition. The number of such matrices will be 3190. As an example displayed 4 such matrices. Then, all of these 3190 matrices tested for the second condition.

st:= time():

It:=proc(K)

[seq([0,op(K[i])],i=1..nops(K)),seq([1,op(K[i])],i=1..nops(K))];

end proc:

M:=(It@@5)([[ ]]):

H:=[]:

for L[1] in M do

for L[2] in M do

for L[3] in M do

for L[4] in M do

for L[5] in M do

if add(add(L[i][j],i=1..3),j=1..3)=5 and add(add(L[i][j],i=1..3),j=2..4)=5 and add(add(L[i][j],i=1..3),j=3..5)=5 and

   add(add(L[i][j],i=2..4),j=1..3)=5 and add(add(L[i][j],i=2..4),j=2..4)=5 and add(add(L[i][j],i=2..4),j=3..5)=5 and

   add(add(L[i][j],i=3..5),j=1..3)=5 and add(add(L[i][j],i=3..5),j=2..4)=5 and add(add(L[i][j],i=3..5),j=3..5)=5 then

   H:=[op(H), Matrix([L[1],L[2],L[3],L[4],L[5]])]: fi:

od: od: od: od: od:

'nops(H)'=nops(H);  seq(H[n],n=1001..1004);

P:=[ ]:

for k in H do

if add(add(k[i,j],i=1..2),j=1..4)=4 and add(add(k[i,j],i=1..2),j=2..5)=4 and add(add(k[i,j],i=2..3),j=1..4)=4 and

   add(add(k[i,j],i=2..3),j=2..5)=4 and add(add(k[i,j],i=3..4),j=1..4)=4 and add(add(k[i,j],i=3..4),j=2..5)=4 and

   add(add(k[i,j],i=4..5),j=1..4)=4 and add(add(k[i,j],i=4..5),j=2..5)=4 and add(add(k[i,j],j=1..2),i=1..4)=4 and

   add(add(k[i,j],j=1..2),i=1..4)=4 and add(add(k[i,j],j=1..2),i=1..4)=4 and add(add(k[i,j],j=1..2),i=1..4)=4 and

   add(add(k[i,j],j=1..2),i=1..4)=4 and add(add(k[i,j],j=1..2),i=1..4)=4 and add(add(k[i,j],j=1..2),i=1..4)=4 and

   add(add(k[i,j],j=1..2),i=1..4)=4

   then P:=[op(P), k]: fi:

od:

P;   

time() - st;

The evalf command after solve command for systems as well as fsolve gives only 1 solution.

Possible decision of this problem:

 

f:=x->x^3-3*x^2+2:

g:=x->k*(x+1)+3:

RealDomain[solve]([f(x) = g(x), diff(f(x),x) = diff(g(x),x)]);

evalf(allvalues([%]));

 

Got all the solutions in both symbolic and numerical form!

Your solution is right.

I suggest another variant to solve your problem without solve command by direct computation (firstly find the points of tangancy):

restart:  with(geom3d):  with(linalg):  

line(d1,[-5+2*t,-3*t+1,-13+2*t],t):  line(d2,[-7+3*t,-1-2*t,8],t):  

a:=ParallelVector(d1):  b:=ParallelVector(d2):  

c:=crossprod(a,b):

sphere(S, x^2+  y^2 + z^2 -10*x +2*y +26*z -113=0, [x,y,z]):

T:=coordinates(center(S)):  R:=radius(S): 

H:=[T + [seq(c[i]/norm(c,2)*R,i=1..3)], T - [seq(c[i]/norm(c,2)*R,i=1..3)]]:

for i to 2 do

sort(Equation(plane(P,c[1]*(x-H[i,1]) +c[2]*(y-H[i,2]) +c[3]*(z-H[i,3]) =0,[x,y,z])), {x,y,z}):

od;

I have not found a suitable way to sort, so I suggest a way to manually isolate complete squares.

The code:

restart:  with(geom3d):

a:=[-t, -t, t]: point(T, a): point(A, 1, -1, -1): point(B, 2, 1, 2): point(C, 1, 3, 1): plane(ABC, [A,B,C], [x, y, z]):

d:= distance(T, ABC):  R:= distance(T, A):

r:= R^2 - d^2;  simplify(r) assuming real;

sol:= minimize(r, location);  Sol:= op(sol[2])[1];

point(T, subs(Sol, a)):  R:= subs(Sol, R):

Eq:=lhs(Equation(sphere(S, [T,R], [x, y, z])));

(x+coeff(Eq,x)/2)^2+(y+coeff(Eq,y)/2)^2+(z+coeff(Eq,z)/2)^2=sqrt((coeff(Eq,x)^2+coeff(Eq,y)^2+coeff(Eq,z)^2)/4-tcoeff(Eq))^`2`;  # Canonical equation of S

You can use the parametric equations of the surface.

The example:

theta:=Pi/3:

plot3d( [u*cos(t)*cos(theta), u*cos(t)*sin(theta), u*sin(t)], u=0..1, t=0..2*Pi, color=red, axes=normal, scaling=constrained, style=surface, view=[-1..1, -1..1, -1.2..1.2] );

First 278 279 280 281 282 283 284 Page 280 of 284