vv

13977 Reputation

20 Badges

10 years, 37 days

MaplePrimes Activity


These are answers submitted by vv

The first two (iterated) limits do not exist, because the inner limits do not exist.
Maple answers correctly:
f:=(x+y)*sin(1/x)*sin(1/y);
limit( f, x=0); # ==> an interval

The last limit is 0 (provided that x,y are real; the limit does not exist in C);

limit(f, {x=0, y=0});  # ==> 0

Yes, it's a bug.

A := <"11",12,13;21,"22",23>:
DocumentTools[Tabulate](A, width=40, fillcolor=((x,i,j)->`if`(irem(j,2)=1,cyan,red)) ):  #ok

DocumentTools[Tabulate](A, width=40,      color=((x,i,j)->`if`(irem(j,2)=1,cyan,red)) ):  # only the strings are colored

 

 

Here is the direct approach, i.e. defining the procedures.

P := proc(t) option remember; a*ED(t - 1) + P(t - 1)   end;
ED := proc(t) option remember; DC(t) + DF(t) end;
DC := proc(t) option remember; c*(P(t) - P(t - 1)) end;
DF := proc(t) option remember; b*(F - P(t)) end;
a := 1;
c := 0.75;
b := 0.2;
F := 100;
P(0) := F;
P(1) := F + 1;

P(10), DF(10);

     99.38828842, 0.122342316

plot( [seq([t,P(t)],t=0..100)]);  # you may want to add style=point

In principle, Student:-Precalculus:-CompleteSquare should work but in this case it complicates things.
I prefer to use my generalized version:

SQR:=proc(P::polynom(anything,x), x::name)
local n:=degree(P,x)/2, q,r,Q,R,k;
if not(type(n,posint)) then error "degree(P) must be even" fi;
Q:=add(q[k]*x^k,k=0..n-1) + sqrt(lcoeff(P,x))*x^n;
R:=add(r[k]*x^k,k=0..n-1); 
solve({coeffs(expand(P-Q^2-R),x)}, {seq(q[k],k=0..n-1),seq(r[k],k=0..n-1)});
eval(Q,%)^2+eval(R,%)
end:

expr1:=-lambda-(1/2)*kappa__c-gamma__p-(1/2)*sqrt(-16*N*g^2+4*lambda^2-8*lambda*gamma__p+4*lambda*kappa__c+4*gamma__p^2-4*gamma__p*kappa__c+kappa__c^2):

evalindets(expr1, sqrt, t -> SQR( op(1,t), lambda)^op(2,t));

 

{seq(msolve({a = k, a*b = 2391}, 10000), k = 1 .. 9999)};

 

with(ImageTools): 
img0:=Read("smile.jpg"):   str:="Just a test!":
img1:=Scale(img0,1..50):
img:=Create(400,400,channels=3,background=white):
simg:=(x,y) -> SetSubImage(img,img1, min(max(floor(400-400*y-25),1),350), min(max(floor(400*x-25),1),350)):
Explore( plot(x^2,x=0..1, background=simg(a,a^2), axes=none, title=str[1..floor(15*a)]), a=0..1., animate,loop,autorun);

(The file "smile.jpg"  must be in the current directory).

Your system has a sigularity at t=0.
Just replace in ICS:  S(0) = 30 with say S(0.001) = 30  etc. It will work.
 

It was answered recently here.

You cannot use the operator * as a name. So, use  beta[`*`], or even better `beta__*`.

Also, remove the last comma in params.
 

In Maple there are many options for numerical integration (including compiled external libraries) which usually can increase considerably the speed. You should choose the proper ones for your case. Read the help pages:

?evalf,int

and also the provided links.

# The coordonates for the center of B is (x, r+d).
x^2 + (d+r)^2 = (R+r)^2;
solve(%,x);
u := factor(%[1]);

# The coordinates of the contact are:
R/(R+r) * <u, d+r>;

 

 

a:=1; b:=2; c:=3;  # semi axes
plot3d([a*cos(theta)*sin(phi),b*sin(theta)*sin(phi),c*cos(phi)],
theta=0..2*Pi,phi=0..Pi,scaling=constrained,axes=boxed);

For a=b=c=1 (as in your code) you have a sphere.

restart;   # Continuous roots w1(k)..w5(k) of a polynomial (wrt parameter k in 0..1)
with(plots):
f := -135/4*w^5+369/16*w^3*k^2+47/4*I*w^4-93/16*I*w^2*k^2+w^3-2/3*w^3*k*B-27/16*k^4*w+3/16*I*k^4-1/3*w*k^2+2/9*k^3*w*B:
B0:=1:
ini:=fsolve(eval(f,[B=B0,k=1/2]),w):
ode:=diff(eval(f,[w=W(k),B=B0]),k):
solode:=seq(dsolve({ode,W(1/2)=ii},numeric),ii=[ini]):
display(Matrix(2,5,
        [ [seq( odeplot(solode[i], [k,Re(W(k))], k=0..1,title=w[i]), i=1..5)],
          [seq( odeplot(solode[i], [k,Im(W(k))], k=0..1), i=1..5)] ]
),thickness=3);

 

I found an interesting mathematical fact about this question.

 

restart:

# The problem: given the points

X := -7/2, -2,  0, 1, 5/2, 4;
Y := -5,    2, -2, 0, -3,  3;

-7/2, -2, 0, 1, 5/2, 4

 

-5, 2, -2, 0, -3, 3

(1)

# Find a polynomial f of degree n (not given) such that

# f(X[i])    = Y[i], i=1..6;
# D(f)(X[i]) = 0,    i=2..5;
# and f is monotonic in each interval X[i]..X[i+1],  i=1..5

 

We show that such a polynomial does not exist for n=13.

To obtain this, we use the simplex package, imposing the conditions on coefficients.
For monotonicity, we'll use a few points in each X[i]..X[i+1]  and impose D(f) >= (or <=) 0 at these points.

 

 

n := 13;

13

(2)

f  := unapply(add(x^k*u[k],k=0..n),x);
f1 := D(f);

proc (x) options operator, arrow; x^13*u[13]+x^12*u[12]+x^11*u[11]+x^10*u[10]+x^9*u[9]+x^8*u[8]+x^7*u[7]+x^6*u[6]+x^5*u[5]+x^4*u[4]+x^3*u[3]+x^2*u[2]+x*u[1]+u[0] end proc

 

proc (x) options operator, arrow; 13*x^12*u[13]+12*x^11*u[12]+11*x^10*u[11]+10*x^9*u[10]+9*x^8*u[9]+8*x^7*u[8]+7*x^6*u[7]+6*x^5*u[6]+5*x^4*u[5]+4*x^3*u[4]+3*x^2*u[3]+2*x*u[2]+u[1] end proc

(3)

h := 1/4  ;  # step for the points in X[i]..X[i+1]

1/4

(4)

cond:=
seq(f(X[k])=Y[k], k=1..6),
seq(f1(X[k])=0, k=2..5),
seq( seq( (-1)^i * f1(x) <= 0, x=X[i] .. X[i+1],h), i=1..5):

sol:=simplex[minimize](0, [cond] );

{}

(5)

No solution, so such a polynomial does not exist!

 

Let's try n:= 14.

 

n := 14;
f  := unapply(add(x^k*u[k],k=0..n),x);
f1 := D(f);
h := 1/64  ;  # step for the points in X[i]..X[i+1]; (we have increased the number of points!)
cond:=
seq(f(X[k])=Y[k], k=1..6),
seq(f1(X[k])=0, k=2..5),
seq( seq( (-1)^i * f1(x) <= 0, x=X[i] .. X[i+1],h), i=1..5):

14

 

proc (x) options operator, arrow; u[0]+x*u[1]+x^2*u[2]+x^3*u[3]+x^4*u[4]+x^5*u[5]+x^6*u[6]+x^7*u[7]+x^8*u[8]+x^9*u[9]+x^10*u[10]+x^11*u[11]+x^12*u[12]+x^13*u[13]+x^14*u[14] end proc

 

proc (x) options operator, arrow; 14*x^13*u[14]+13*x^12*u[13]+12*x^11*u[12]+11*x^10*u[11]+10*x^9*u[10]+9*x^8*u[9]+8*x^7*u[8]+7*x^6*u[7]+6*x^5*u[6]+5*x^4*u[5]+4*x^3*u[4]+3*x^2*u[3]+2*x*u[2]+u[1] end proc

 

1/64

(6)

sol:=simplex[minimize](0, [cond] );

{u[0] = -2, u[1] = 0, u[2] = 26081725798822911724387519169/5067601993388288422544590800, u[3] = -209301227334631756989453239687/319258925583462170620309220400, u[4] = -37357553325552043628490134973047/10641964186115405687343640680000, u[5] = 237828002249525740211505427717/2280420897024729790145065860000, u[6] = 3825654951826024764376104015023/3547321395371801895781213560000, u[7] = -3786179266045998000568222999/1330245523264425710917955085000, u[8] = -16656371336575917028433611243/95017537376030407922711077500, u[9] = -12203069609036618869950136/166280690408053213864744385625, u[10] = 408700907804577876559215073/26604910465288514218359101700, u[11] = 0, u[12] = -341722007659028479755083386/498842071224159641594233156875, u[13] = 0, u[14] = 6091816625704339278413824/498842071224159641594233156875}

(7)

ff:=eval(f(x), sol);

-2+(26081725798822911724387519169/5067601993388288422544590800)*x^2-(209301227334631756989453239687/319258925583462170620309220400)*x^3-(37357553325552043628490134973047/10641964186115405687343640680000)*x^4+(237828002249525740211505427717/2280420897024729790145065860000)*x^5+(3825654951826024764376104015023/3547321395371801895781213560000)*x^6-(3786179266045998000568222999/1330245523264425710917955085000)*x^7-(16656371336575917028433611243/95017537376030407922711077500)*x^8-(12203069609036618869950136/166280690408053213864744385625)*x^9+(408700907804577876559215073/26604910465288514218359101700)*x^10-(341722007659028479755083386/498842071224159641594233156875)*x^12+(6091816625704339278413824/498842071224159641594233156875)*x^14

(8)

# So, we apparently found a "solution"

plot(ff, x=-3.5 .. 4);

 

plot(diff(ff,x), x=-3.5 .. 4);

 

plot(diff(ff,x), x=3.7 .. 3.8);

 

# So, f is not actually increasing in the last interval X[5]..X[6]

 

In order to decide if f exists for n=14 we should decrease h  (e.g. h=1/256 etc) . If simplex gives an empty solution, f does not exist.

 

Actually, for h=1/256 the plot of f is

but it's not difficult to see that the monotonicity also fails (just like for h=1/64).


I had not the patience to choose h small enough, but I suspect that n=14 fails too!

   

Download PolynomialFit-simplex.mw

I seems that a polynomial of degree <=13 satisfying the "marked" conditions in the provided graph and having also a similar "shape" (i.e. same sign for the derivative) does not exist.

N:=13:
t:= unapply(add(x^k*u[k],k=0..N),x):
sol:=solve([
        t(-7/2)=-5,
        t(-2)  = 2, 
        t(0)   = -2, 
        t(1)   = 0, 
        t(5/2) = -3, 
        t(4)=3, 
        D(t)(-2)=0,
        D(t)(0)=0,
        D(t)(1)=0,
        D(t)(5/2)=0,
        D(t)(-7/2)=a,  # a>0
        D(t)(4)=b,     # b>0
        t(-1)=c,       # -1<c<1
        t(7/2)=d       # -1<d<1
      ], [seq(u[i],i=0..N)] 
     
)[]:
P:=eval(t(x),sol):
#indets(P);
Explore(plot(P, x=-3.5..4), parameters=[[a=0. .. 100],[b=0. .. 100], [c=-1. .. 1],[d=-1. .. 1]]);

 

First 54 55 56 57 58 59 60 Last Page 56 of 120