Kitonum

15379 Reputation

24 Badges

12 years, 110 days

MaplePrimes Activity


These are answers submitted by Kitonum

Your system contains too many parameters  Q11A, Q11Ay, Q11Az, Q11Iy, Q11Iz, Q11J, Q16A, Q16Ay, Q16Az, Q16Iz, Q16J, Q55A, Q55Ay, Q55Iy, Q66A, Q66Az, Q66Iz  (total 17 ones) with unknown values. If you specify the values of these parameters, Maple easily solves this system. I took parameter values from 1 to 17.

 

Download copy1_new.mw

Here is a procedure for this:

LeastDegree:=proc(P::polynom, var::{set,list})
local L;
L:=sort(map(p->degree(p,var),[op(P)]));
select(p->degree(p,var)=L[1],P);
end proc:


Examples of use:

f:= 100*x^2*y^2 + 35*x^2*y + 45*y:
g:= 13*x^2*y^2 + x*a*y^2 + 2*y*x^2:
LeastDegree(f, [x,y]);
LeastDegree(g, [x,y]);
                                            
45*y
                                     a*x*y^2+2*x^2*y

Edit.

Specify the range for x:

plot(sin(4*x)+1/3*cos(6*x), x=0..2*Pi);

 

This animation shows thin cylindrical disks, summing up the volumes of which and passing to the limit, we get the exact volume:

restart;
f:=x^(1/2):
g:=x^2/8:
X:=r*cos(phi): Y:=r*sin(phi):
P:=plot3d(eval([[X,Y,f],[X,Y,g]],x=r), r=0..4, phi=0..2*Pi, style=surface, color=["Khaki","LightBlue"], scaling=constrained, axes=normal, labels=[z,x,y], orientation=[20,80], transparency=0.5):
F:=y->plots:-display(plot3d([[r*cos(phi),r*sin(phi),y],[r*cos(phi),r*sin(phi),y+h]], r=y^2..sqrt(8*y), phi=0..2*Pi, style=surface, color=gold), plot3d([[y^2*cos(phi),y^2*sin(phi),H],[sqrt(8*y)*cos(phi),sqrt(8*y)*sin(phi),H]], H=y..y+h, phi=0..2*Pi, style=surface, color=gold)):
h:=0.15:
plots:-animate(F,[y], y=0..2-h, frames=60, background=P);

                   

# Volume of this body in 2 ways
Int(Pi*(8*y-y^4), y=0..2)=int(Pi*(8*y-y^4), y=0..2);  # Washer (disk) method
Int((sqrt(x)-x^2/8)*2*Pi*x, x=0..4)=int((sqrt(x)-x^2/8)*2*Pi*x, x=0..4);  # Shell (cylinder) method
                      

 
 

I guess that you consider this function to be real-valued, so its domain will be x>0 and x<1 . The solution to your problem is based on 2 key properties that are easy to prove:
1. The graph of the function is symmetric with respect to the line  x = 1/2 .
2. For any  a>2 the function  f(x)  has  1 local  maximum at  x=1/2  and 2 local minimums  x1  and  x2 

By virtue of symmetry, all these conditions (df/dx(x=x1)=df/dx(x=x2)=0 and f(x1)=f(x2)) are satisfied for these points x1  and  x2. Below the calculation of  x1  and  x2  and the plotting for  a=3 .

restart;
f:=(x,a)->a*x*(1-x)+x*ln(x)+(1-x)*ln(1-x);
limit(f(x,a),x=0);
plot(f(x,3),x=0..1);
x1:=fsolve(diff(f(x,3),x));
x2:=1-x1;
plot(f(x,3), x=x1..x2);

                    

 

                           

 

A:=d*n0/dt+d*epsilon*n1/dt+d*epsilon^(3/2)*n2/dt+d*epsilon^2*n3/dt+epsilon*d*n0*u1/dx+epsilon^(3/2)*d*n0*u2/dx+d*n0*epsilon^2*u3/dx+d*epsilon^2*n1*u1/dx+d*epsilon^(5/2)*n1*u2/dx:
coeff(A,epsilon^(3/2));

                                     d*n2/dt+d*n0*u2/dx        

The list  L2 contains all the options for representing numbers from your list in a sum of no more than 5 different squares.

For some reason, the document is not displayed inline. Therefore, I copied the code and the output fragment:

restart;
Squares:=[seq(i^2,i=0..12)]:
k:=0:
for n from 129 to 129+13^2 do
for m from 1 to 5 do
for c in combinat:-choose(Squares,m) do
if n=add(c) then k:=k+1; L[k]:=[n,c] fi;
od: od: od:
L:=convert(L,list):
L1:={seq(p[1]=`+`(seq(sqrt(p[2][i])^`2`,i=1..nops(p[2]))),p=L)}:
L2:=[ListTools:-Categorize((x,y)->lhs(x)=lhs(y),[L1[]])]:
for p in L2 do
lhs(p[1])=`or`(seq(rhs(p[k]),k=1..nops(p)));
od;

  



Download sums_squares2.mw

Edit.

I made 2 graphs: the first is static with a cutout in the first octant for greater clarity, the second is dynamic (animation). The upper and lower surfaces are made in different colors and the scale is equalized in all axes (scaling=constrained):

restart;
f:=x^(1/2):
g:=x^2/8:
X:=r*cos(phi): Y:=r*sin(phi):
plot3d(eval([[X,Y,f],[X,Y,g]],x=r), r=0..4, phi=Pi/2..2*Pi, color=["LightBlue","Khaki"], scaling=constrained, axes=normal, labels=[z,x,y], orientation=[25,75], lightmodel=light1);
plots:-animate(plot3d,[eval([[X,Y,f],[X,Y,g]],x=r), r=0..4, phi=Pi/2..a, color=["LightBlue","Khaki"], scaling=constrained, axes=normal, labels=[z,x,y], orientation=[25,75], lightmodel=light1], a=Pi/2..5*Pi/2, frames=60);

   

You mean the arithmetic mean? Why waste your time and look for the appropriate command if the problem is solved simply by adding the distances between all kinds of pairs of vertices and dividing by the number of these pairs. Here is an example:

with(GraphTheory):
G := Graph([1, 2, 3, 4, 5], {{1, 2}, {1, 3}, {1, 4}, {1, 5}, {2, 3}, {2, 5}, {3, 4}, {4, 5}}):
Dists:=AllPairsDistance(G);
`+`(seq(seq(Dists[i,j],j=i+1..5),i=1..4))/10;

                           

 

In this example (when we set the graph  G ), distances are not specified and, by default, the length of each edge is assumed to be 1.

Edit. The last line of code can be written shorter:
  add(add(Dists[i,j], j=i+1..5), i=1..4)/10;

Index:=proc(v::{Vector,Array})
local i0,i1,i;
i0:=`if`(v::Vector,1,lhs(op(v)[1]));
i1:=`if`(v::Vector,op(v)[1],rhs(op(v)[1]));
for i from i0 to i1 do
if v[i]>=0 then return i fi;
od;
end proc: 

Examples of use:
V:=Vector([-1,-1,-2,0,3,4]):
Index(V);
V1:=Array(0..3, [-1,-2,4,-5]):
Index(V1);
V2:=Vector([-1,-1,-2]):
Index(V2);

                                 4
                                 2


Edit.
                                       

f:=x->-(x^3-6*x^2+11*x-6)*(x^2-4*x+5)/(x^4-8*x^3+24*x^2-32*x+17);
plot([f(x),2-x], x=-2..6, linestyle=[1,3],color=[red,blue], thickness=[2,0], scaling=constrained);

            


Addition. There is a rational function with polynomials of lower degrees satisfying all conditions:

f:=x->(-x^3+6*x^2-11*x+6)/(x^2-4*x+5);
convert(f(x),parfrac);
plot([f(x),2-x], x=-4..8, -5..5,  linestyle=[1,3],color=[red,blue], thickness=[2,0], scaling=constrained);

 

Here is a procedure for this:

Grouping:=proc(L::listlist)
local L1;
uses ListTools;
L1:=[Categorize((x,y)->x[2]=y[2], L)];
map(p->[p[1,2],map(l->l[1],p)], L1);
end proc:


Example of use:

MyNestedList := [   [g1, [1,2,3]]     ,   [g2, [0,1,3]]   ,  [g3, [1,2,3]]  ,  [g4, [0,1,3]]]:
Grouping(MyNestedList);
                 
 [[[1, 2, 3], [g1, g3]], [[0, 1, 3], [g2, g4]]]

I replaced  D  with  Daw  because  D  is the differential operator in Maple. We have a transcendental equation  m = 0.9058763835e-3*sqrt(6)/(x^2*m^2*exp(-26.00000000*x*m))-1/2-0.2884615385e-1/(x*m)  that we can solve only numerically. On the plot we see that for each  x   there are 2 values of  . In the code we find  m  with the smallest modulus:
 

restart;
Daw:=x->exp(-x)*int(_t^2,_t=0..sqrt(x));
N:=q->exp(q)/sqrt(q)*sqrt(3/2)*Daw(3*q/2);

proc (x) options operator, arrow; exp(-x)*(int(_t^2, _t = 0 .. sqrt(x))) end proc

 

proc (q) options operator, arrow; exp(q)*sqrt(3/2)*Daw((3/2)*q)/sqrt(q) end proc

(1)

t:=0.6: n:=6: k:=1.3:
q:=(24/(n-3))*(x*k*m)/t;
Eq:=m= 1/2*(exp(q)/(q*N(q))-1-1/q);
plots:-implicitplot(Eq, x=0..10,m=-1..0, gridrefine=3);

17.33333333*x*m

 

m = 0.9058763835e-3*6^(1/2)/(x^2*m^2*exp(-26.00000000*x*m))-1/2-0.2884615385e-1/(x*m)

 

 

f:=unapply('fsolve'(m= 1/2*(exp(q)/(q*N(q))-1-1/q),m=-0.25..0),x);

proc (x) options operator, arrow; fsolve(m = 0.9058763835e-3*6^(1/2)/(x^2*m^2*exp(-26.00000000*x*m))-1/2-0.2884615385e-1/(x*m), m = -.25 .. 0) end proc

(2)

# Examples of use
f(0.5), f(1), f(5);

-.2066314659, -0.7733721921e-1, -0.1398887471e-1

(3)

 


 

Download Equation.mw

restart;
F:=()->RandomTools:-Generate(choose([1$2, 2$5, 3, 4, 5])):
# Example of use
seq(F(), i=1..100);
ListTools:-Collect([%]);

4, 1, 4, 2, 1, 2, 1, 1, 4, 2, 2, 2, 5, 1, 2, 5, 2, 3, 2, 2, 2, 2, 

  1, 1, 2, 4, 2, 5, 1, 1, 2, 3, 5, 2, 1, 2, 2, 4, 1, 1, 1, 1, 4, 

  2, 2, 5, 2, 2, 1, 3, 2, 1, 2, 2, 2, 5, 2, 4, 2, 5, 2, 1, 2, 2, 

  4, 1, 5, 4, 2, 1, 3, 2, 3, 3, 5, 2, 2, 1, 2, 1, 2, 1, 2, 2, 3, 

  2, 2, 1, 5, 3, 5, 5, 5, 2, 2, 1, 2, 4, 2, 1
          [[1, 25], [2, 44], [3, 8], [4, 10], [5, 13]]
 

See this a toy example:

A:=a+b*x=0:
coeff(A, x);
coeff(lhs(A), x);

                       Error, unable to compute coeff
                                               b

 

First 11 12 13 14 15 16 17 Last Page 13 of 240