Kitonum

21435 Reputation

26 Badges

17 years, 24 days

MaplePrimes Activity


These are answers submitted by Kitonum

The direction field (by arrows) will only be displayed for one first-order equation or for an autonomous system of two first-order equations.

From the help for DEtools:-DEplot command: "A system of two first order differential equations produces a direction field plot, provided the system is determined to be autonomous. In addition, a single first order differential equation produces a direction field (as it can always be mapped to a system of two first order autonomous differential equations). A system is determined to be autonomous when all terms and factors, other than the differential, are free of the independent variable. For more information, see DEtools[autonomous]. For systems not meeting these criteria, no direction field is produced (only solution curves are possible in such instances). There can be only one independent variable."
 

Specifying a complex function in  complex variables is equivalent to specifying two real functions, each in  2*n  real variables.

Example for n=2 :

restart;
f:=(z1,z2)->(z1+z2)^2;
z1:=x1+I*y1: z2:=x2+I*y2:
u:=unapply(evalc(Re(f(z1,z2))),(x1,y1,x2,y2));
v:=unapply(evalc(Im(f(z1,z2))),(x1,y1,x2,y2));

(u+I*v)(1,2,3,4); # Example of a calculation

\

 

 

This expression is a real number (if  z  and  b  are real numbers):

A:=(ln (-z * I + b) - ln (z * I + b)) * I;
simplify(evalc(A)) assuming z>0,b>0 ;
simplify(evalc(A)) assuming z>0,b<0 ;

                   

 

                         

F:=beta[1]*exp(x*alpha[1]+y*beta[1]-z*sqrt(-alpha[1]^2-beta[1]^2))/(1+exp(x*alpha[1]+y*beta[1]-z*sqrt(-alpha[1]^2-beta[1]^2)));
evalc(F); # F in algebraic form (assuming all the parameters are reals)
evalc(Re(F));
evalc(Im(F));

 

I interpreted OP's question as how to find tetrahedra with integer edges and volume, and such that all edges are different. The code below finds all substantially different solutions, i.e. such tetrahedra, which cannot be obtained from one another by isometry, and whose edges are coprime, If the edge lengths <= 20, we obtain 68 solutions under these conditions. Also, all solutions are sorted in ascending order of volume (the first number in each list).


 

restart;
k:=0: N:=20:
L:=seq(seq([i,j],j=i+1..4),i=1..3):
M := Matrix(5, (i,j) -> `if`(i=j, 0, `if`(i=1 or j=1, 1, d[sort([i-1,j-1])[]]^2)));
V1:=LinearAlgebra:-Determinant(M):
for d[1,2] from 1 to N-2 do
for d[1,3] from d[1,2]+1 to N-1 do
for d[1,4] from d[1,3]+1 to N do
for d[2,3] from abs(d[1,3]-d[1,2])+1 to min(N,d[1,3]+d[1,2]-1) do
for d[2,4] from abs(d[1,4]-d[1,2])+1 to min(N,d[1,4]+d[1,2]-1) do
for d[3,4] from abs(d[1,4]-d[1,3])+1 to min(N,d[1,3]+d[1,4]-1) do
if d[2,3]<d[2,4]+d[3,4] and d[2,4]<d[2,3]+d[3,4] and d[3,4]<d[2,4]+d[2,3] then V2:=V1/288;
if type(V2,integer) then v1:=isqrt(V2);
if v1^2=V2 and v1>0 and nops({d[1,2],d[1,3],d[1,4],d[2,3],d[2,4],d[3,4]})=6 then V:=v1; k:=k+1; R[k]:=[V,[d__12=d[1,2],d__13=d[1,3],d__14=d[1,4],d__23=d[2,3],d__24=d[2,4],d__34=d[3,4]]] fi;fi;fi;
od: od: od: od: od: od:
R:=convert(R,list):
R0:=select(t->igcd(rhs~(t[2])[])=1, R):
R1:=[ListTools:-Categorize((X,Y)->{{rhs(X[2,1]),rhs(X[2,6])},{rhs(X[2,2]),rhs(X[2,5])},{rhs(X[2,3]),rhs(X[2,4])}}={{rhs(Y[2,1]),rhs(Y[2,6])},{rhs(Y[2,2]),rhs(Y[2,5])},{rhs(Y[2,3]),rhs(Y[2,4])}} and X[1]=Y[1], R0)]:
n:=nops(R1);
{seq(R1[i,1],i=1..n)}[];
 

Matrix(5, 5, {(1, 1) = 0, (1, 2) = 1, (1, 3) = 1, (1, 4) = 1, (1, 5) = 1, (2, 1) = 1, (2, 2) = 0, (2, 3) = d[1, 2]^2, (2, 4) = d[1, 3]^2, (2, 5) = d[1, 4]^2, (3, 1) = 1, (3, 2) = d[1, 2]^2, (3, 3) = 0, (3, 4) = d[2, 3]^2, (3, 5) = d[2, 4]^2, (4, 1) = 1, (4, 2) = d[1, 3]^2, (4, 3) = d[2, 3]^2, (4, 4) = 0, (4, 5) = d[3, 4]^2, (5, 1) = 1, (5, 2) = d[1, 4]^2, (5, 3) = d[2, 4]^2, (5, 4) = d[3, 4]^2, (5, 5) = 0})

 

69

 

[6, [d__12 = 2, d__13 = 5, d__14 = 7, d__23 = 6, d__24 = 8, d__34 = 4]], [12, [d__12 = 2, d__13 = 5, d__14 = 13, d__23 = 6, d__24 = 14, d__34 = 16]], [18, [d__12 = 4, d__13 = 5, d__14 = 14, d__23 = 7, d__24 = 16, d__34 = 18]], [21, [d__12 = 2, d__13 = 9, d__14 = 11, d__23 = 10, d__24 = 12, d__34 = 8]], [21, [d__12 = 4, d__13 = 6, d__14 = 10, d__23 = 8, d__24 = 7, d__34 = 13]], [21, [d__12 = 8, d__13 = 10, d__14 = 12, d__23 = 16, d__24 = 17, d__34 = 19]], [24, [d__12 = 2, d__13 = 7, d__14 = 13, d__23 = 8, d__24 = 14, d__34 = 12]], [36, [d__12 = 4, d__13 = 6, d__14 = 10, d__23 = 7, d__24 = 12, d__34 = 13]], [36, [d__12 = 5, d__13 = 7, d__14 = 9, d__23 = 8, d__24 = 13, d__34 = 11]], [36, [d__12 = 6, d__13 = 8, d__14 = 14, d__23 = 11, d__24 = 16, d__34 = 7]], [36, [d__12 = 6, d__13 = 8, d__14 = 16, d__23 = 11, d__24 = 14, d__34 = 12]], [42, [d__12 = 4, d__13 = 5, d__14 = 18, d__23 = 6, d__24 = 20, d__34 = 16]], [42, [d__12 = 4, d__13 = 10, d__14 = 11, d__23 = 12, d__24 = 14, d__34 = 16]], [42, [d__12 = 4, d__13 = 10, d__14 = 14, d__23 = 12, d__24 = 11, d__34 = 17]], [42, [d__12 = 4, d__13 = 12, d__14 = 18, d__23 = 13, d__24 = 20, d__34 = 9]], [42, [d__12 = 5, d__13 = 13, d__14 = 15, d__23 = 16, d__24 = 19, d__34 = 7]], [42, [d__12 = 9, d__13 = 11, d__14 = 16, d__23 = 19, d__24 = 17, d__34 = 15]], [42, [d__12 = 10, d__13 = 11, d__14 = 17, d__23 = 16, d__24 = 14, d__34 = 12]], [48, [d__12 = 3, d__13 = 11, d__14 = 14, d__23 = 12, d__24 = 15, d__34 = 9]], [48, [d__12 = 4, d__13 = 6, d__14 = 16, d__23 = 8, d__24 = 14, d__34 = 19]], [48, [d__12 = 4, d__13 = 6, d__14 = 17, d__23 = 8, d__24 = 19, d__34 = 14]], [48, [d__12 = 4, d__13 = 14, d__14 = 17, d__23 = 16, d__24 = 19, d__34 = 6]], [48, [d__12 = 5, d__13 = 6, d__14 = 11, d__23 = 7, d__24 = 10, d__34 = 13]], [48, [d__12 = 5, d__13 = 6, d__14 = 11, d__23 = 7, d__24 = 14, d__34 = 13]], [48, [d__12 = 5, d__13 = 6, d__14 = 13, d__23 = 7, d__24 = 16, d__34 = 17]], [48, [d__12 = 5, d__13 = 6, d__14 = 16, d__23 = 7, d__24 = 13, d__34 = 14]], [48, [d__12 = 5, d__13 = 6, d__14 = 16, d__23 = 7, d__24 = 19, d__34 = 14]], [48, [d__12 = 5, d__13 = 7, d__14 = 10, d__23 = 8, d__24 = 11, d__34 = 15]], [48, [d__12 = 5, d__13 = 7, d__14 = 16, d__23 = 8, d__24 = 15, d__34 = 11]], [48, [d__12 = 5, d__13 = 10, d__14 = 15, d__23 = 11, d__24 = 16, d__34 = 7]], [48, [d__12 = 5, d__13 = 11, d__14 = 13, d__23 = 14, d__24 = 16, d__34 = 6]], [48, [d__12 = 5, d__13 = 14, d__14 = 18, d__23 = 15, d__24 = 17, d__34 = 8]], [48, [d__12 = 6, d__13 = 7, d__14 = 8, d__23 = 11, d__24 = 10, d__34 = 9]], [48, [d__12 = 6, d__13 = 13, d__14 = 14, d__23 = 17, d__24 = 16, d__34 = 7]], [60, [d__12 = 7, d__13 = 8, d__14 = 12, d__23 = 14, d__24 = 10, d__34 = 16]], [60, [d__12 = 7, d__13 = 10, d__14 = 16, d__23 = 12, d__24 = 11, d__34 = 14]], [63, [d__12 = 5, d__13 = 8, d__14 = 15, d__23 = 12, d__24 = 16, d__34 = 14]], [63, [d__12 = 6, d__13 = 10, d__14 = 16, d__23 = 11, d__24 = 17, d__34 = 8]], [72, [d__12 = 5, d__13 = 12, d__14 = 15, d__23 = 13, d__24 = 14, d__34 = 9]], [78, [d__12 = 7, d__13 = 11, d__14 = 13, d__23 = 16, d__24 = 19, d__34 = 15]], [84, [d__12 = 4, d__13 = 10, d__14 = 17, d__23 = 12, d__24 = 19, d__34 = 14]], [84, [d__12 = 6, d__13 = 7, d__14 = 16, d__23 = 8, d__24 = 14, d__34 = 19]], [84, [d__12 = 6, d__13 = 11, d__14 = 16, d__23 = 12, d__24 = 18, d__34 = 9]], [90, [d__12 = 6, d__13 = 8, d__14 = 14, d__23 = 11, d__24 = 17, d__34 = 12]], [90, [d__12 = 7, d__13 = 8, d__14 = 12, d__23 = 11, d__24 = 10, d__34 = 16]], [105, [d__12 = 6, d__13 = 8, d__14 = 16, d__23 = 12, d__24 = 15, d__34 = 18]], [105, [d__12 = 7, d__13 = 10, d__14 = 11, d__23 = 12, d__24 = 16, d__34 = 14]], [105, [d__12 = 8, d__13 = 9, d__14 = 10, d__23 = 11, d__24 = 12, d__34 = 16]], [105, [d__12 = 8, d__13 = 9, d__14 = 12, d__23 = 13, d__24 = 10, d__34 = 18]], [105, [d__12 = 8, d__13 = 9, d__14 = 16, d__23 = 13, d__24 = 18, d__34 = 10]], [105, [d__12 = 8, d__13 = 9, d__14 = 18, d__23 = 11, d__24 = 16, d__34 = 12]], [105, [d__12 = 8, d__13 = 10, d__14 = 16, d__23 = 12, d__24 = 18, d__34 = 9]], [105, [d__12 = 8, d__13 = 11, d__14 = 14, d__23 = 15, d__24 = 20, d__34 = 10]], [120, [d__12 = 7, d__13 = 8, d__14 = 13, d__23 = 11, d__24 = 14, d__34 = 15]], [120, [d__12 = 7, d__13 = 11, d__14 = 14, d__23 = 16, d__24 = 19, d__34 = 15]], [126, [d__12 = 4, d__13 = 15, d__14 = 20, d__23 = 16, d__24 = 18, d__34 = 19]], [126, [d__12 = 9, d__13 = 11, d__14 = 13, d__23 = 19, d__24 = 17, d__34 = 16]], [132, [d__12 = 7, d__13 = 13, d__14 = 14, d__23 = 16, d__24 = 18, d__34 = 10]], [132, [d__12 = 8, d__13 = 11, d__14 = 12, d__23 = 14, d__24 = 16, d__34 = 10]], [162, [d__12 = 8, d__13 = 11, d__14 = 12, d__23 = 15, d__24 = 16, d__34 = 14]], [165, [d__12 = 7, d__13 = 13, d__14 = 18, d__23 = 16, d__24 = 14, d__34 = 20]], [168, [d__12 = 8, d__13 = 9, d__14 = 15, d__23 = 13, d__24 = 19, d__34 = 18]], [168, [d__12 = 8, d__13 = 11, d__14 = 15, d__23 = 17, d__24 = 19, d__34 = 16]], [210, [d__12 = 8, d__13 = 10, d__14 = 16, d__23 = 12, d__24 = 17, d__34 = 19]], [231, [d__12 = 9, d__13 = 10, d__14 = 19, d__23 = 14, d__24 = 16, d__34 = 20]], [231, [d__12 = 10, d__13 = 11, d__14 = 17, d__23 = 12, d__24 = 14, d__34 = 16]], [288, [d__12 = 9, d__13 = 11, d__14 = 19, d__23 = 14, d__24 = 20, d__34 = 18]], [300, [d__12 = 10, d__13 = 14, d__14 = 20, d__23 = 16, d__24 = 15, d__34 = 19]], [330, [d__12 = 10, d__13 = 13, d__14 = 18, d__23 = 14, d__24 = 16, d__34 = 20]]

(1)

 


Edit. The code has been fixed. The necessary condition  X[1]=Y[1]  added to the  ListTools:-Categorize command.

Download itetr2.mw

Alternatively, you can do the same without matrices. Also, I multiplied each frame 5 times to make the animation slower.

T:= seq(k, k= 1..9):  X:= seq(k^2, k= 1..9):
plots:-display(seq(plot([seq([T[i],X[i]],i=1..k)])$5,k=1..9),insequence);

         

 

Use  mtaylor  command for this. 

Example:

restart;
i2 := (x,y) -> -(1/2)*I*(exp(I*x)*(sin(x)/x)-exp(I*y)*(sin(y)/y))/(x-y);
i3_r := -(1/2)*I*(i2(y,z)-i2(y,x))/(z-x);
mtaylor(i3_r, {x,y,z}, 6);

Because these 3 points are located in the same plane (the plane  yOz ), then you can use the  CurveFitting:-LeastSquares  command. We use a 1st degree polynomial  z=a*y+b . Increasing the degree gives nothing, because you have only 3 points, and two of them lie on the same vertical. A polynomial of any degree  z=P(y)  found by the least squares method will pass through point  C  and the middle of the segment  AB :

restart;
with(plots):
A:=[0,0,0]: B:=[0,0,1]: C:=[0,1,0]:
eq:=CurveFitting:-LeastSquares([A[2..3],B[2..3],C[2..3]], y);
P1:=spacecurve([0,y,eq], y=-1..2, color=green, thickness=2):
P2:=pointplot3d([A,B,C],color=[blue,red,black], symbol=cross, symbolsize=40, thickness=2):
P3:=textplot3d([[A[],"A"],[B[],"B"],[C[],"C"]], font=[TIMES,14], align={above,left}):
display(P1,P2,P3, labels=[x,y,z], view=[(-1..1)$3], orientation=[125,65]);

1/2-(1/2)*y

 

 

 

Download 3_points.mw

1. I made some corrections to your worksheet that Thomas Richard mentioned already.

2. I am not quite sure what exactly you want to plot. For each value of  y , equations   and  b  define some lines on the plane. Below on the first graph these lines are plotted for  y = 1 . On the second graph, using the  Explore  command, you can trace how these graphs change with the change in the variable  y .

restart;
# z=0.001, 0.002  and  r=0.1-0.3
para := z=0.001, r=0.1:
eq := 1-((z/x^2)+(1-r)/(x-y)^2+r/(x+((1-r)/r)*y)^2)=0:
eq1 := subs({x=p+q*I,para},eq);

a := evalc(Re(eq1));
b := evalc(Im(eq1));

plots:-implicitplot(eval([a,b],y=1), p=-0.3..2.3, q=-0.5..0.5, color=[red,blue], thickness=2, gridrefine=4, scaling=constrained, size=[1000,300], axes=box, legend=["a","b"], title = "The plots of a and b for y=1", titlefont=[TIMES,16]);

Explore(plots:-implicitplot([a,b], p=-5..3, q=-0.5..0.5, color=[red,blue], thickness=2, gridrefine=4, scaling=constrained, size=[800,300], axes=box, legend=["a","b"], title = "The plots of a and b for y=0..2", titlefont=[TIMES,16]), y=0...2.);

1-0.1e-2/(p+I*q)^2-.9/(p+I*q-y)^2-.1/(p+I*q+9.000000000*y)^2 = 0

 

1-0.1e-2*(p^2-q^2)/((p^2-q^2)^2+4*p^2*q^2)-.9*(p^2-2*p*y-q^2+y^2)/((p^2-2*p*y-q^2+y^2)^2+(2*p*q-2*q*y)^2)-.1*(p^2+18.00000000*p*y-q^2+81.00000000*y^2)/((p^2+18.00000000*p*y-q^2+81.00000000*y^2)^2+(2*p*q+18.00000000*q*y)^2) = 0

 

0.2e-2*p*q/((p^2-q^2)^2+4*p^2*q^2)+.9*(2*p*q-2*q*y)/((p^2-2*p*y-q^2+y^2)^2+(2*p*q-2*q*y)^2)+.1*(2*p*q+18.00000000*q*y)/((p^2+18.00000000*p*y-q^2+81.00000000*y^2)^2+(2*p*q+18.00000000*q*y)^2) = 0

 

 

 

Download eq_(1)_new.mw

Should be the  plots:-contourplot  command instead of the  contourplot one,  because it is from a pluggable package plots.

Remove the extra letter from the command name. Should be  plot3d   instead of  plotd3d .


 

restart;

f:=(x,y)->x^4-3*x^2-2*y^3+3*y+1/2*x*y;

proc (x, y) options operator, arrow; x^4-3*x^2-2*y^3+3*y+(1/2)*x*y end proc

(1)

Find the critical points:  

 

CriticalPoints:= [solve( {diff(f(x,y),x)=0,diff(f(x,y),y)=0}, {x,y}, explicit)]:
evalf(%);

[{x = 0.5935572277e-1, y = .7105957432}, {x = 1.191117672, y = .77411872}, {x = 1.255942703, y = -.77760007}, {x = -0.5877159444e-1, y = -.7036351094}, {x = -1.197482099, y = -.63262139}, {x = -1.250162405, y = .62914212}]

(2)

Find the second partial derivatives:

A:=diff(f(x,y),x,x); B:=diff(f(x,y),x,y); C:=diff(f(x,y),y,y);

12*x^2-6

 

1/2

 

-12*y

(3)

 

In a loop, using the quadratic form  A*C-B^2, examine each of the 6 critical points:

for k from 1 to 6 do
S:=evalf(CriticalPoints[k]);
Q:=eval(A*C-B^2,S); A0:=eval(A,S); f0:=eval(f(x,y),S);
if Q>0 then if A0<0 then R[k]:=[Maximum,S,f0] else R[k]:=[Minimum,S,f0] fi;fi;
if Q<0 then R[k]:=[Saddle,S,f0] fi;
od:
Matrix([[Type_of_point,Point,Value_of_function],seq(R[k],k=1..6)]);

Matrix(7, 3, {(1, 1) = Type_of_point, (1, 2) = Point, (1, 3) = Value_of_function, (2, 1) = Maximum, (2, 2) = {x = 0.5935572277e-1, y = .7105957432}, (2, 3) = 1.424693902, (3, 1) = Saddle, (3, 2) = {x = 1.191117672, y = .77411872}, (3, 3) = -.3878073192, (4, 1) = Minimum, (4, 2) = {x = 1.255942703, y = -.77760007}, (4, 3) = -4.124751020, (5, 1) = Saddle, (5, 2) = {x = -0.5877159444e-1, y = -.7036351094}, (5, 3) = -1.403836003, (6, 1) = Minimum, (6, 2) = {x = -1.197482099, y = -.63262139}, (6, 3) = -3.258364349, (7, 1) = Saddle, (7, 2) = {x = -1.250162405, y = .62914212}, (7, 3) = -1.249935209})

(4)

Plotting:

P1:=plot3d(f(x,y),x=-2..2,y=-2..2, view=-6..6):
P2:=plots:-pointplot3d([seq(eval([x,y,z],[R[k][2][],z=R[k][3]]),k=1..6)],color=red, symbol=solidsphere, symbolsize=18):
plots:-display(P1,P2, orientation=[60,60]);

 

 


The plot clearly shows: one maximum, two minimums and three saddles

Download zadelpunten_procedure_new.mw

Use the  seq  command for this.
Example:

restart;
L:=[0, Pi/6, Pi/4, Pi/3, Pi/2];
[seq([p,sin(p)], p=L)];

                

restart;
P:=x^4 - x^2 + x - 1:
A:=PolynomialTools:-Split(P, x);
convert(A, radical);
simplify(expand(%));  # A check

1. For  isolve a system should be specified as a set (not a list).
2. You need to specify exactly what you mean by the smallest positive solution, because the solution will not be one number, but an ordered set of numbers (a list). For example, which is less: [2, 4] or [1, 5] ?

In the solution below, the solutions are sorted by the minimum sum of the squares of all coordinates.

restart;
sys:= {a[1] = 2 * a[5], a[1] = a[4], 4 * a[1] + 2 * a[3] = a[6] + 2 * a[7], 2 * a[2] + 2 * a[3] = 2 * a[6], a[2] = a[4] + a[5], 2 * a[2] -a[1] = 2 * a[4]};
indets(sys);
n:=nops(%);
isolve(sys);
assign(%);
solve({seq(a[i]>0, i=1..n)});
[seq(seq([seq(a[i],i=1..n)],_Z2=floor(5*_Z1/2)+1..10),_Z1=1..10)];
sort(%, key = (x->add(x[i]^2,i=1..n)));

        

First 26 27 28 29 30 31 32 Last Page 28 of 289