vv

13837 Reputation

20 Badges

9 years, 317 days

MaplePrimes Activity


These are answers submitted by vv

# 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]]);

 

residue connot compute the residue at a pole with symbolic order.
It's easy to write a procedure in this case provided that you know the order of the pole. It is based on Maple's ability to compute the derivative of a symbolic order, but it will fail for complex expressions.

Res:=(f,z,a,p) -> limit(diff(f*(z-a)^p,[z$(p-1)]), z=a)/(p-1)!:
# p = the order of the pole z=a

f := exp(-z/A)/z^(2 + n):
Res(f,z,0,n+2);

        

Try to increase Digits. For example,

restart;
Digits:=10;
n:=10;
x:=ln(1+0.1^n);
x^x;

==> Float(undefined). Increasing Digits ==> OK.

 

restart;

It's an interesting problem.

The points  Z(n, eps)   can be written as complex numbers, so that the computation will be easy and fast.

Starting from

Z(1, eps)=0, Z(2, eps)=1, Z(3, eps)=1+I*eps

 

then  for Z = X + I*Y,

 

  X(2*n+1, eps) - Y(2*n+1,eps)^2 - 1 0,  for small eps.

 

So, the "limit curve" is almost  a parabola (at least near Z=1).

 

Digits:=40;

40

(1)

f:=(Z1,Z2,Z3) -> Z1 + conjugate((Z2-Z3)/(Z1-Z3)) * (Z1-Z3);
N:=10^4; epsilon:=1e-5; Z:=Vector(N):
Z[1]:=0:  Z[2]:=1:  Z[3]:=1+I*epsilon;
Z[4]:=f(Z[1],Z[2],Z[3]):  Z[5]:=f(Z[3],Z[1],Z[4]):
for i from 6 to N do
Z[i]:=f(Z[i-2],Z[i-3],Z[i-1]) od:

proc (Z1, Z2, Z3) options operator, arrow; Z1+conjugate((Z2-Z3)/(Z1-Z3))*(Z1-Z3) end proc

 

10000

 

0.1e-4

 

1.+0.1e-4*I

(2)

 

X:=Vector(N/2-1, i -> Re(Z[2*i+1])):
Y:=Vector(N/2-1, i -> Im(Z[2*i+1])):
maxY:=max(Y);

0.4990711393221379712016621884051685006329e-1

(3)

# The result (for eps --> 0) is almost a parabola (near Z=1)!
plots:-display(plot(Y,X, thickness=12,color=green), plot(y^2+1, y=0..maxY, color=red));

 

int( sqrt(1+4*y^2),y=0 .. maxY );

0.4998986029275945551447823599821645242220e-1

(4)

 

You must use

Explore('a'[i], i = 1 .. 3);

otherwise accessing a[i]  with symbolic i, produces an error.

(Explore has special evaluation rules, the first argument is passed unevaluated).

 

pde:={diff(u(x,t),t) =K*diff(u(x,t),x, x), D[1](u)(0,t)=0}: 
# u(x,infinity) = infinity,  diff(u(x,t),x) =0 when x=0 for all t 
sol:=pdsolve(pde, generalsolution);

# ==> (changing the constants)

u(x,t) = A*( exp(c*(K*c*t+x))+exp(c*(K*c*t-x)) );

  


# A>0, c>0 [K>0]
# pdsolve says it's the general solution, but with pdsolve you can never know

SolveTools:-SemiAlgebraic([x^2+y^2+z^2-4*x+6*y-2*z-11 = 0, 2*x+2*y-z = -18], [x,y,z]);

       [[x = -4/3, y = -19/3, z = 8/3]]
              

 

You should post text, or preferably Maple code instead of low resolution pictures.

Anyway, you do not need Change if your f is smooth:
int(diff(f(s),s), s = a..b, continuous);
      - f(a) + f(b)

 

Chebyshev already had the smart idea in 1853, see here.

After a change of variables ( x+1 --> x), it's a binomial integral

Int( x^m * (A + B*x^n)^p, x);

where m=-3/2, n=3*b, p=-1/2

Using Chebyshev's result, assuming that b is rational (and a<>0, a<>1 of course), the integral is an elementary function iff
b = 1/(6*k), or b = 1/(6*k + 3),  where k is an integer.

Yes, the computation are very slow in the general case.

You can speed up considerably the computations if you use hardware floats.

If A is the 0-1 matrix, define B:=Matrix(A, datatype=float)   and compute C := B^k.
The result will be exact provided that the entries of C are < 2^53 =~ 9.0*10^15.

Another posibility is to use LinearAlgebra:-Modular.

Here I have assumed the usual multiplication. For a custom multiplication you may use LinearAlgebra:-Generic.

 

The level sets BS_Price = B (B constant) are 4-dimensional manifolds.
The equation can be solved e.g. wrt K. (It is convenient to use IERF the inverse erf function, see the code below).

To visualize the 3d sections, one can use Explore.

restart;
BS_Price=exp(-r*T)*(-(1/2)*erf((1/4)*sqrt(2)*(sigma^2*T-2*r*T+2*ln(K)-2*ln(S__0))/(sigma*sqrt(T)))+1/2);
IERF(2*B*exp(r*T)-1) = (-(1/2)*sigma^2*T+r*T-ln(K)+ln(S__0))*sqrt(2)/(2*sigma*sqrt(T));
EQK:=solve(%, K);
IERF:= z -> RootOf(erf(_Z)-z):
Explore(plot3d(EQK, r = 0 .. -ln(B)/T, T=0.5 .. 2, labels=[r,T,K]), 
parameters=[sigma=0.01 ..1, S__0=0.01 ..2, B=0.01  ..0.95]);

 

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