Carl Love

Carl Love

28065 Reputation

25 Badges

13 years, 21 days
Himself
Wayland, Massachusetts, United States
My name was formerly Carl Devore.

MaplePrimes Activity


These are answers submitted by Carl Love

Easy analytic geometry solution:

A:= <1,2,3>:  v:= <1,2,2>:  C:= <10,11,12>:
L:= A+t*v:

We want the point where line L intersects the plane normal to containing point C:

B:= eval(L, t= solve(L.v = C.v));

Plot:

plots:-display(
    plots:-implicitplot3d(
        <x,y,z>.v = C.v, ([x,y,z]=~ 0..15)[], 
        style= surface, transparency= .2
    ), 
    plots:-pointplot3d([A,B,C], connect, color= red, thickness= 3),
    orientation= [80, 80, 130], axes= frame, labels= [``$3]
);


 

NULL

n:= 3:

V:= 'LinearAlgebra:-RandomVector(n)' $ n;

V := Vector(3, {(1) = 92, (2) = -31, (3) = 67}), Vector(3, {(1) = 99, (2) = 29, (3) = 44}), Vector(3, {(1) = 27, (2) = 8, (3) = 69})

A:= `<|>`(V); # `<|>` is the columnwise juxtaposition operator.

Matrix(3, 3, {(1, 1) = 92, (1, 2) = 99, (1, 3) = 27, (2, 1) = -31, (2, 2) = 29, (2, 3) = 8, (3, 1) = 67, (3, 2) = 44, (3, 3) = 69})

R:= A^%T.A; # ^%T is the transposition operator.

Matrix(3, 3, {(1, 1) = 13914, (1, 2) = 11157, (1, 3) = 6859, (2, 1) = 11157, (2, 2) = 12578, (2, 3) = 5941, (3, 1) = 6859, (3, 2) = 5941, (3, 3) = 5554})

X:= 1/A; #inverse matrix

Matrix(3, 3, {(1, 1) = 1649/327244, (1, 2) = -5643/327244, (1, 3) = 9/327244, (2, 1) = 2675/327244, (2, 2) = 4539/327244, (2, 3) = -1573/327244, (3, 1) = -3307/327244, (3, 2) = 2585/327244, (3, 3) = 5737/327244})

#Verification that X has the property you asked for:
seq(A.X[..,k], k= 1..3);

Vector(3, {(1) = 1, (2) = 0, (3) = 0}), Vector(3, {(1) = 0, (2) = 1, (3) = 0}), Vector(3, {(1) = 0, (2) = 0, (3) = 1})

``


 

Download BasicLA.mw

If you use option matrixview, then the vertical-axis tickmarks are indexed -1, -2, ..., -20.

The command SPolynomial is in package Groebner not package Ore_algebra.

 

You need to do two things:

1. Your plot range 0..5 is much too big for this problem. Change it to approximately 0..0.01 (for all plots).

2. Add the option maxfun= 0 to the dsolve command. This will remove any limitation on the number of points that it needs to compute.

3. (Optional) Remove output= listprocedure. It doesn't do anything beneficial in this case, and I'm always suspicious of it.

Here it is. Obviously the placement of the sliders could be prettier, but I think mathematically it's all done. MaplePrimes can't handle Explore plots, but it should be there when you download the worksheet.
 

S-I-R infectious disease model with added vaccination-rate parameter

restart
:

Digits:= 15
:

Both I and gamma are difficult to use in Maple. I've changed these to H and y

ODEs:=.
    (diff(S(t),t) = (S+R)(t)*b - S(t)*(beta*H(t) + v + d)),
    (diff(H(t),t) = H(t)*(beta*S(t) - delta - y + b)),
    (diff(R(t),t) = v*S(t) - R(t)*d + y*H(t))
:

ICs:= S(0) = S__0, H(0) = I__0, R(0) = R__0:

SIR:= dsolve(
   {ODEs, ICs}, parameters= [b, beta, v, d, delta, y, S__0, I__0, R__0],
   numeric, maxfun= 0, abserr= 1e-13
):

Explore(
    proc()
    local
        #population growth function scaled to initial pop. = 1 = 100%:
        N:= t-> exp((b-delta-d)*t)
    ;
        SIR('parameters'=
                [b, beta, v, d, delta, y, S__0, I__0, R__0]
        );
        plots:-odeplot(
            SIR, `[]`~(t, [S, H, R](t)*~exp((b-d-delta)*t)), t= 0..50,
            color= [green, yellow, pink], legend= [` S `,` I `,` R `],
            labels= [:-t, `Pop.`], view= [DEFAULT, 0..1]
        )
    end proc(),
    'parameters'= [
        S__0= 0.0..1.0, I__0= 0.0..1.0, R__0= 0.0..1.0,
        b=  0.0..1.0, delta= 0.0..1.0, d= 0.0..1.0, v= 0.0..1.0,
        y= 0.0..0.8, beta= 0.0..2.0
    ]
);
            

 


 

Download VaccinationRateSIR.mw

You're missing a closing parenthesis at the end of the line immediately above end. Note that when your cursor is immediately after a closing bracket, then a faint box appears around it's opening match. 

Looks like you're doing the elliptic curve addition! Good.

You have a few more errors that will just cause weirdness rather than an error message:

  1. Assignment is := not =.
  2. Expand does nothing without mod.
  3. Multiplication should use an *.

Here is a phase portrait for the three-tree-frog system using some parameter values and initial conditions that I just made up. You'll need to do a lot of playing around with the parameters to figure out the rest of part (c) of the problem.
 

restart
:

Digits:= 15
:

From: Steven Strogatz, Nonlinear Dynamics and Chaos, page 304, problem 8.6.9.

 

I do part a) in my head, rewriting the equations in terms of phi and psi:

ODEs:=
   diff(phi(t),t) = -2*H(phi(t))-H(phi(t)+psi(t))+H(psi(t)),
   diff(psi(t),t) = H(phi(t))-H(phi(t)+psi(t))-2*H(psi(t))
;

diff(phi(t), t) = -2*H(phi(t))-H(phi(t)+psi(t))+H(psi(t)), diff(psi(t), t) = H(phi(t))-H(phi(t)+psi(t))-2*H(psi(t))

Part c) The interaction function:

H:= x-> a*sin(x)+b*sin(2*x):

Make up some initial conditions:

ICs:= phi(0) = c, psi(0) = d:

Sol:= dsolve(
   {ODEs, ICs}, parameters= [a,b,c,d],
   numeric, maxfun= 0, abserr=1e-13
):

Experiment with some parameter values:

Sol(parameters= [a=2,b=5,c=2,d=3]):

Phase portrait:

plots:-odeplot(
   Sol, [phi(t),psi(t)], t= 0..50,
   numpoints= 10000, gridlines= false
);

 


 

Download ThreeTreeFrogs.mw

Tima, I don't think that there is a simpler way to solve this, but there are a few much better ways. The problem with most standard solutions, such as the one you give, is that the real roots end up with false small imaginary parts and it's iffy whether those roots get plotted. (I call them spurious imaginary parts.) Here are two methods that avoid that problem. The first method also gives exact symbolic solutions (just as yours does), but they are constructed such that evaluating them numerically gives pure real numbers.

To understand the rest of this, it helps to know that there are 2 real roots for a=0 and 3 real roots for any in (0,1]. It's easy to prove this with elementary calculus, and it's also verified by solve(..., real, parametric) solution. You should look at that solution in the worksheet, but it's so wide on the screen that I don't want to put it directly on MaplePrimes.

Download SolveParametric.mw

restart:
f:= (x,a)-> x^3 + (a-3)^3*x^2 - a^2*x + a^3:
Titles:= ["Least root", "Middle root", "Greatest root"]:
PlotIt:= R-> 
    local k,
    Views:= `[]`~(`..`~(R~([0,1])[]), 0..1):
    plots:-display(
        `<|>`(
            seq(
                plot([a-> R(a)[k], a-> a, 0..1], view= Views[k], title= Titles[k]),
                k= 1..3
            )
        ),
        labels= [x,a], gridlines= false
    )
:
Method 1: solve(..., real, parametric): This gives the exact symbolic roots in 
RootOf form but in such a way that floating-point evaluation of the real roots 
does not produce spurious imaginary parts.
st:= time():
SolP:= solve(f(x,a) = 0, x, real, parametric):
SolPR:= subsindets(
    subs([x=0]= ([x=0]$2), SolP), #Account for double root at x=0, a=0.
    [identical(x)= anything],
    e-> op([1,2], e) #I.e., change every [x=r] to r.
):
P1:= PlotIt(proc(a) option remember; evalf(eval(SolPR, :-a= a)) end proc):
time() - st; 
                             2.922

Method 2: fsolve: This also avoids spurious imaginary parts (for 
polynomials with real coefficients). But it doesn't give exact, symbolic
solutions.
st:= time():
P2:= PlotIt(proc(a) option remember; local x; [fsolve(f(x,a))] end proc):
time() - st;
                             0.766

P1; #plot via solve(..., parametric)

P2; #plot via fsolve

 

J:= <
    118, 174, 374, 597, 670, 677, 516, 407, 
    291, 196, 155, 101, 66, 34, 21, 9
>:
A:= <seq(2.5+5*k, k= 0..15)>:
plot(
   <A|J>, style= point, symbol= asterisk, symbolsize= 16,
   labels= [Age, JOHOR], labeldirections= [horizontal,vertical],
   view= [0..80, 0..1.1*max(J)], axes= boxed
);

Mathematically speaking, the job can be done with a single short command, plottools:-transform. The shaded regions will turn out a bit ragged, but a mathematically sophisticated viewer will understand what's represented. An alternative is to not use shading in the original plot, and then the transform'd result will look perfect, like this:

restart:
z:= x+I*y: #Complex z must be defined in terms of real x and y for this to work.
A:= plots:-implicitplot(
   [evalc(abs(z)) < 3, evalc(1 < abs(z - 1))],
   x= -5..5, y= -5..5,
   scaling= constrained, grid= [100$2]
);
#Regardless of how you construct the original plot above, the code below
#remains the same:
x1:= (9 - sqrt(45))/2; x2:= (9 + sqrt(45))/2;
M:= (3 + sqrt(5))/2*(z - x1)/(z - x2);
plottools:-transform(unapply(evalc([Re,Im](M)), (x,y)))(A);

Note that the argument of transform is a function from R2 to Rwhere the output is a list (i.e., in square brackets such as [x,y]) and the input is just a sequence (i.e., such as (x,y)). The output of transform is itself a function which can be applied to a plot---in this case, any 2D plot.

Using Maple 2019, if I give your second command, the one with discont, then I get exactly what you want. So, there's some bug in your Maple 2015 that has since been fixed. The same bug may also affect the output of the following plot command; on the other hand, it may work in Maple 2015:

plot(
   3/(1-3/2*sin(theta)), theta= 0..2*Pi, discont, 
   coords= polar, axiscoordinates= polar, 
   coordinateview= [0..10, 0..2*Pi], discont
);

This should produce a plot identical to the equivalent polarplot command, and indeed it does in Maple 2019.

All of the inputs to the GF field operations need to be processed by ConvertIn before use. (For what it's worth, this is needed to put them into the zppoly format that I mentioned earlier. But you don't need to understand that format to work with GF.) So, this works:

G:= GF(2, 3, T^3+T^2+1):
t:= G:-ConvertIn(T):
G:-`*`(t,t);

You also asked:

  • how do I specify what variable is used for my finite field without needing to specify an irreducible polynomial?

The field elements are indexed in a predictable way. The index of the extension element itself is always the field characteristic (the prime). So, if you want to use T, do

restart:
G:= GF(2,3):
T:= G:-input(2):
G:-`*`(T,T);

 

One would think that if the "pattern" variables a, bwere made local, that would solve the problem. It's easy enough to make them local:

EinsteinRule:= e->
    local a, b, i;
    applyrule(
        vec(a::symbol, i::symbol) * vec(b::symbol, i::symbol) = 
            dotproduct(a,b),
        e
    )
:

But I am absolutely dumb-founded that that doesn't fix your issue. There should now be absolutely no connection between the a in the applyrule command and any a that you may happen to use in the arguments. Yet...

EinsteinRule(vec(a,k)*vec(b,k));
                        dotproduct(a, b)
EinsteinRule(vec(u,k)*vec(u,i)*vec(c,k));
                   dotproduct(c, u) vec(u, i)
EinsteinRule(vec(a,k)*vec(a,i)*vec(c,k));
                 vec(a, k) vec(a, i) vec(c, k)

That's a critical flaw in applyrule. It's as if it's converting things to strings and comparing the strings.

I've never liked applyrule ​​​​​​anyway. Here's a version using the much more versatile command subsindets:

EinsteinRule:= e-> 
    subsindets(
        e,
        `*`,
        proc(p) 
        local V,v,o,pv,c;
            (V,o):= selectremove(type, p, :-vec(symbol$2));
            v:= {op(V)};
            for pv in combinat:-choose(v,2) do
                c:= op~(pv) minus `intersect`((`{}`@op)~(pv)[]);
                if nops(c)=2 then
                    V/= mul(pv)/dotproduct(c[]);
                    break
                fi
            od;
            V*o
        end proc
    )
:

Now, try the same three examples.

I am not familiar with the Einstein summation convention, so I tried to generalize reasonably just from the information that you provided. My procedure may not have captured every nuance of it.

If you read my Answer to the other similar Question that you Replied to, you'll see how to work with finite fields of non-prime order using just the mod command. This is by far the easiest way to start. After that, you can learn GF, then after that modp1 and modp2.

First 122 123 124 125 126 127 128 Last Page 124 of 395