Carl Love

Carl Love

28095 Reputation

25 Badges

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

MaplePrimes Activity


These are answers submitted by Carl Love

Here is a complete simulation for the three-door Monty Hall problem (the classic). The code is very straightforward to read. See if you can extend this to the four-door problem.

MontyHall:= proc(N::posint, {switch::truefalse:= false})
# Simulation for the 3-door Monty Hall problem. N is the number
# of trials. Returns the number of trials the player wins.
local
     wins:= 0,
     PrizeDoor, #The door with the prize behind it (1..3).
     MontysDoor,  # The door that Monty reveals (1..3).
     Players1stDoor,  # The door the player picks first.
     Players2ndDoor,  # The door the player picks second.
     Doors:= {1,2,3},
     rand3:= rand(1..3), rand2:= rand(1..2)
;
     to N do
          PrizeDoor:= rand3();
          Players1stDoor:= rand3();
          if Players1stDoor = PrizeDoor then
               MontysDoor:= (Doors minus {PrizeDoor})[rand2()]
          else
               MontysDoor:= (Doors minus {PrizeDoor,Players1stDoor})[]
          end if;
          if switch then
               Players2ndDoor:= (Doors minus {MontysDoor,Players1stDoor})[]
          else
               Players2ndDoor:= Players1stDoor
          end if;
          if Players2ndDoor = PrizeDoor then
               wins:= wins+1
          end if
     end do;
     wins
end proc:     

MontyHall(100000);
                             33282
MontyHall(100000, switch);
                             66915

You asked:

How would i label the axis and change its font and size?

By using plot options labels and labelfont. (Example shown below.)

Also, how would i move the horizontal axis down, so that the whole diagram can be seen?

By using plot options axes= box and view. (Example shown below.)

Finally, there are some odd points between 0 and 1 on the vertical axis. How do you get rid of these?

Those are very interesting and seem to be an integral result of the computation for small values of r and some x, although it may also be an effect of round-off error. I will investigate that further. To eliminate them from the plot, slightly increase the lower bound for the view of the horizontal axis. I used 0.1 as the increase amount in the example show below.

Bonus: Here's how you can generate this plot in well under 1 second by using evalhf. It's at least a factor-of-50 improvement timewise over the old way. I set this up such that it will be easy to modify for other bifurcation diagrams.

restart:
Rloop:= proc(Pts::Matrix, r_min::realcons, r_max::realcons, N::posint, M::posint)
local n, r, x, r_range:= r_max - r_min;
     for n to N do
          r:= r_min+n/N*r_range;
          x:= Pts[n,2];
          to M do  x:= x*exp(r*(1-x))  end do;
          Pts[n,1]:= r;  Pts[n,2]:= x
     end do;
     NULL
end proc:     

(N,M):= 10^~(4,2):  (x_min,x_max):= (0,1):  (r_min,r_max):= (0,4):
bifpoint:= Matrix(N,2, datatype= float[8]):
bifpoint[.., 2]:=
     < RandomTools:-Generate(list(float(range= x_min..x_max, method= uniform), N))[] >:
evalhf(Rloop(bifpoint, r_min, r_max, N, M)):
pitchf:= plots:-pointplot(bifpoint, symbol=point):
plots:-display(
     pitchf,
     axes= box, view= [r_min+0.1..r_max, -1..5],
     labels= ['r','x'], labelfont= [TIMES,BOLDITALIC,16],
     axesfont= [HELVETICA,BOLD,12]
);

 

You can use the events option to dsolve to detect when the derivative is 0. If you post the equations, I'll help to set it up. Otherwise, you can read about it at ?dsolve,events . (Warning: This help page is quite esoteric.)

While it's true that you can't use solve with the output of dsolve(..., numeric), you can use fsolve.

I believe that your error "Empty script base" is related to the 2D input. I have never seen it before. When I convert your expression to 1D input with Convert tool on the Format menu, it looks very weird to me:

E~:=(k__x,k__y,k__z)~->~&+-Ɣsqrt((1)+(4~cos(3/(2)k__ya__cc)cos((((sqrt(3)))/(2))k__xa__cc))+((4)((cos^(2)(((sqrt(3))/(2))k__xa__cc))^()))6";

The tildes (~) and quotation marks make no sense to me.

Here is how I would type your expression in 1D input:

E:= (k__x, k__y, k__z)->
    &+- gamma*sqrt(1+4*cos(3/2*k__y*a__cc)*cos(sqrt(3)/2*k__x*a__cc) +
               4*cos(sqrt(3)/2*k__x*a__cc)^2);

To substitute the values for gamma and a__cc, do

E:= subs([gamma= 3*1.6e-19, a__cc= 0.142e-9], eval(E));

Names created with parse are always global. So you'll need to make PEA global instead of local for your code to work.

If you can describe what you're actually trying to accomplish, I can probably suggest a better way to do it.

Maple allows the upper bound of a plot range to be infinity:

plots([n^3, (n+1)^2], n= 3..infinity, legend= [n^3, (n+1)^2]);

or

plot(n^3 - (n+1)^2, n= 3..infinity);

Maple can prove some simple inequalities "on its own":

is(n^3 > (n+1)^2) assuming n >= 3;
                    
              true

 

Here is a procedure that might help you. It adds a Vector to an Array iff the Vector does not already appear in the Array. It returns true if the Vector was added and false otherwise.

AddIfNew:= proc(A::{Array,Vector}, V::rtable)
local n:= numelems(A);
     if not ormap(LinearAlgebra:-Equal, A, V) then
          A(n+1):= V;
          return true
     end if;
     false
end proc:

Example of its use:

A:= Array([]):
for k to 26 do
     AddIfNew(A, LinearAlgebra:-RandomVector(2, generator= rand(1..5)))
end do:
numelems(A);
                               17
convert(A,list);

It is extremely difficult to get fsolve to produce all the solutions to a system of equations and to know that they are truly all of the solutions. Often it is impossible. In this case, the equations are solvable exactly, so use solve:

seq(eval(y,E), E in solve({a[1],a[2]}, {x,y}, explicit));

To get just the positives, produce the above list and then filter it with select and is like I showed you before:

Sols:= seq(eval(y,E), E in solve({a[1],a[2]}, {x,y}, explicit)):
select(y-> is(y>0), Sols);

If ex is your expression of square roots, try

expand(combine(ex, symbolic));

f:= unapply(Trace(M), x);

BuildMatrix:= (ex::algebraic)->
     Matrix(10, 9, (i,j)-> eval(ex, {C= i, K= j+1}))
:
BuildMatrix(2*K+2*C-3);

@john125 

The issue of dealing with multiple solutions from fsolve only arises when you are solving a single univariate polynomial. In all other cases fsolve returns at most one solution per invocation.

Let p(x) be the polynomial that you are solving. To eliminate duplicates, enclose the fsolve is set-constructor braces:

{fsolve(p(x), x)};

or

{fsolve}(p(x), x);

To only receive nonnegative solutions, include an interval for solutions in the call:

fsolve(p(x), x, 0..infinity);

To also exclude 0, thus making it just positive solutions, do

fsolve(p(x), x, avoid= {x=0}, 0..infinity);

Either of these latter two ideas can be combined with the braces to eliminate duplicates:

{fsolve(p(x), x, avoid= {x=0}, 0..infinity)};

In your second followup, you ask about solving multiple equations for just one of the variables. That is not possible, although you can easily make it so that you only see the solution for one variable. Let's say you just want to see x. Then do

eval(x, fsolve({a,b}, {x,y}));

 

 

 

To get exact solutions, simply use solve instead of fsolve.

To extract the exact positive solutions, do

Sol:= [solve(30+1144*r^4-832*r^2=0)];
select(x-> is(x>0), Sol);

Your solution does not fulfill the exercise because your integral is being done symbolically, not numerically. It's rather tricky to get Maple's numeric differential equation solver (dsolve(..., numeric)) to use a numeric integral. You have to encapsulate the integral in a procedure and then use dsolve's rather arcane protocol for specifying an IVP via a procedure. I wouldn't expect any beginning Maple user to figure it out. So, here's how to do it.

 

MakeDeq:= (f,init)->
     proc(N, t, Y, YP)
          local x;
          YP[1]:= evalf(Int(f, 0..t))
     end proc
:

T:= 10:  numsteps:= 100:  f:= x-> exp(-x^2):  #or f:= x-> x

Sol:= dsolve(
     numeric,
     procedure= MakeDeq(f),
     number= 1,
     start= 0,
     initial= Array(1..1, [0]),
     procvars= [y(t)],
     method= classical[foreuler],
     stepsize= T/numsteps
);

proc (x_classical) local _res, _dat, _vars, _solnproc, _xout, _ndsol, _pars, _n, _i; option `Copyright (c) 2000 by Waterloo Maple Inc. All rights reserved.`; if 1 < nargs then error "invalid input: too many arguments" end if; _EnvDSNumericSaveDigits := Digits; Digits := 15; if _EnvInFsolve = true then _xout := evalf[_EnvDSNumericSaveDigits](x_classical) else _xout := evalf(x_classical) end if; _dat := Array(1..4, {(1) = proc (_xin) local _xout, _n, _y0, _yn, _yl, _ctl, _octl, _reinit, _errcd, _fcn, _i, _yini, _pars, _ini, _par; option `Copyright (c) 2002 by the University of Waterloo. All rights reserved.`; table( [( "complex" ) = false ] ) _xout := _xin; _ctl := Array(1..9, {(1) = 1, (2) = 0., (3) = 0., (4) = .100000000000000, (5) = 50000, (6) = 0, (7) = 0, (8) = 1, (9) = 0}); _octl := Array(1..9, {(1) = 1, (2) = 0., (3) = 0., (4) = .100000000000000, (5) = 50000, (6) = 0, (7) = 0, (8) = 1, (9) = 0}); _n := trunc(_ctl[1]); _yini := Array(0..1, {(1) = 0.}); _y0 := Array(0..1, {(1) = 0.}); _yl := Array(1..1, {(1) = 0}); _yn := Array(1..1, {(1) = 0}); _fcn := proc (N, t, Y, YP) local x; YP[1] := evalf(Int(f, 0 .. t)) end proc; _pars := []; if not type(_xout, 'numeric') then if member(_xout, ["start", "left", "right"]) then return _y0[0] elif _xout = "method" then return "classical" elif _xout = "numfun" then return round(_ctl[6]) elif _xout = "initial" then return [seq(_yini[_i], _i = 0 .. _n)] elif _xout = "parameters" then return [seq(_yini[_n+_i], _i = 1 .. nops(_pars))] elif _xout = "initial_and_parameters" then return [seq(_yini[_i], _i = 0 .. _n)], [seq(_yini[_n+_i], _i = 1 .. nops(_pars))] elif _xout = "last" then if _ctl[3]-_y0[0] <> 0. then _xout := _ctl[3] elif _ctl[2]-_y0[0] <> 0. then _xout := _ctl[2] else error "no information is available on last computed point" end if elif _xout = "enginedata" then return eval(_octl, 1) elif _xout = "function" then return eval(_fcn, 1) elif type(_xin, `=`) and type(rhs(_xin), 'list') and member(lhs(_xin), {"initial", "parameters", "initial_and_parameters"}) then if sing_bool then error "initial conditions cannot be changed for systems with removable singularities" end if; _ini, _par := [], []; if lhs(_xin) = "initial" then _ini := rhs(_xin) elif lhs(_xin) = "parameters" then _par := rhs(_xin) elif select(type, rhs(_xin), `=`) <> [] then _par, _ini := selectremove(type, rhs(_xin), `=`) elif nops(rhs(_xin)) < nops(_pars)+1 then error "insufficient data for specification of initial and parameters" else _par := rhs(_xin)[-nops(_pars) .. -1]; _ini := rhs(_xin)[1 .. -nops(_pars)-1] end if; _xout := lhs(_xout); if _par <> [] then `dsolve/numeric/process_parameters`(_n, _pars, _par, _yini) end if; if _ini <> [] then `dsolve/numeric/process_initial`(_n, _ini, _yini, _pars) end if; if _pars <> [] then _par := {seq(rhs(_pars[_i]) = _yini[_n+_i], _i = 1 .. nops(_pars))}; for _i from 0 to _n do _y0[_i] := subs(_par, _yini[_i]) end do; for _i from _n+1 to _n+nops(_pars) do _y0[_i] := _yini[_i] end do; for _i to nops(_pars) do _yn[_n+_i] := _y0[_n+_i] end do else for _i from 0 to _n do _y0[_i] := _yini[_i] end do end if; _octl[2] := _y0[0]; _octl[3] := _y0[0]; for _i to 9 do _ctl[_i] := _octl[_i] end do; for _i to _n+nops(_pars) do _yl[_i] := _y0[_i] end do; if _Env_smart_dsolve_numeric = true and type(_y0[0], 'numeric') then procname("right") := _y0[0]; procname("left") := _y0[0] end if; if _xout = "initial" then return [seq(_yini[_i], _i = 0 .. _n)] elif _xout = "parameters" then return [seq(_yini[_n+_i], _i = 1 .. nops(_pars))] else return [seq(_yini[_i], _i = 0 .. _n), op(_pars)], [seq(_yini[_n+_i], _i = 1 .. nops(_pars))] end if else return "procname" end if end if; if _xout-_y0[0] = 0. then return [seq(_y0[_i], _i = 0 .. _n)] end if; _reinit := false; if _xin <> "last" then if 0 < 0 and `dsolve/numeric/checkglobals`(0, table( [ ] ), _pars, _n, _yini) then _reinit := true; if _pars <> [] then _par := {seq(rhs(_pars[_i]) = _yini[_n+_i], _i = 1 .. nops(_pars))}; for _i from 0 to _n do _y0[_i] := subs(_par, _yini[_i]) end do; for _i from _n+1 to _n+nops(_pars) do _y0[_i] := _yini[_i] end do; for _i to nops(_pars) do _yn[_n+_i] := _y0[_n+_i] end do else for _i from 0 to _n do _y0[_i] := _yini[_i] end do end if end if; if _pars <> [] and select(type, {seq(_yini[_n+_i], _i = 1 .. nops(_pars))}, 'undefined') <> {} then error "parameters must be initialized before solution can be computed" end if end if; if not _reinit and _xout-_ctl[3] = 0. then [_ctl[3], seq(_yn[_i], _i = 1 .. _n)] elif not _reinit and _xout-_ctl[2] = 0. then [_ctl[2], seq(_yl[_i], _i = 1 .. _n)] else if _ctl[2]-_y0[0] = 0. or sign(_ctl[2]-_y0[0]) <> sign(_xout-_ctl[2]) or abs(_xout-_y0[0]) < abs(_xout-_ctl[2]) or _reinit then for _i to 9 do _ctl[_i] := _octl[_i] end do; for _i to _n+nops(_pars) do _yl[_i] := _y0[_i] end do; for _i to nops(_pars) do _yn[_n+_i] := _y0[_n+_i] end do end if; _ctl[3] := _xout; if Digits <= evalhf(Digits) then try _errcd := evalhf(`dsolve/numeric/classical`(_fcn, var(_ctl), _y0[0], var(_yl), var(_yn), Array(1..1, {(1) = 0}), Array(1..1, {(1) = 0}), Array(1..1, {(1) = 0}), Array(1..1, {(1) = 0}), var(Array(1..3, 1..1, {(1, 1) = 0, (2, 1) = 0, (3, 1) = 0})))) catch: userinfo(2, `dsolve/debug`, print(`Exception in classical:`, [lastexception])); if searchtext('evalhf', lastexception[2]) <> 0 or searchtext('real', lastexception[2]) <> 0 or searchtext('hardware', lastexception[2]) <> 0 then _errcd := `dsolve/numeric/classical`(_fcn, _ctl, _y0[0], _yl, _yn, Array(1..1, {(1) = 0}), Array(1..1, {(1) = 0}), Array(1..1, {(1) = 0}), Array(1..1, {(1) = 0}), Array(1..3, 1..1, {(1, 1) = 0, (2, 1) = 0, (3, 1) = 0})) else _ctl[3] := _y0[0]; _errcd := [lastexception][2 .. -1] end if end try else try _errcd := `dsolve/numeric/classical`(_fcn, _ctl, _y0[0], _yl, _yn, Array(1..1, {(1) = 0}), Array(1..1, {(1) = 0}), Array(1..1, {(1) = 0}), Array(1..1, {(1) = 0}), Array(1..3, 1..1, {(1, 1) = 0, (2, 1) = 0, (3, 1) = 0})) catch: _ctl[3] := _y0[0]; _errcd := [lastexception][2 .. -1] end try end if; if type(_errcd, 'list') or _errcd < 0 then userinfo(2, {dsolve, `dsolve/classical`}, `Last values returned:`); userinfo(2, {dsolve, `dsolve/classical`}, ` t =`, _ctl[2]); userinfo(2, {dsolve, `dsolve/classical`}, ` y =`, _yl[1]); for _i from 2 to _n do userinfo(2, {dsolve, `dsolve/classical`}, `	 `, _yl[_i]) end do; if type(_errcd, 'list') then error op(_errcd) elif _errcd+1. = 0. then Rounding := `if`(_y0[0] < _xout, -infinity, infinity); error "cannot evaluate the solution past %1, maxfun limit exceeded (see ?dsolve,maxfun for details)", evalf[8](_ctl[3]) else Rounding := `if`(_y0[0] < _xout, -infinity, infinity); error "cannot evaluate the solution past %1, unknown error code returned from classical %2", evalf[8](_ctl[3]), trunc(_errcd) end if end if; if _Env_smart_dsolve_numeric = true then if _y0[0] < _xout and procname("right") < _xout then procname("right") := _xout elif _xout < _y0[0] and _xout < procname("left") then procname("left") := _xout end if end if; [_xout, seq(_yn[_i], _i = 1 .. _n)] end if end proc, (2) = Array(0..0, {}), (3) = [t, y(t)], (4) = []}); _vars := _dat[3]; _pars := map(rhs, _dat[4]); _n := nops(_vars)-1; _solnproc := _dat[1]; if not type(_xout, 'numeric') then if member(x_classical, ["start", 'start', "method", 'method', "left", 'left', "right", 'right', "leftdata", "rightdata", "enginedata", "eventstop", 'eventstop', "eventclear", 'eventclear', "eventstatus", 'eventstatus', "eventcount", 'eventcount', "laxtol", 'laxtol', "numfun", 'numfun', NULL]) then _res := _solnproc(convert(x_classical, 'string')); if 1 < nops([_res]) then return _res elif type(_res, 'array') then return eval(_res, 1) elif _res <> "procname" then return _res end if elif member(x_classical, ["last", 'last', "initial", 'initial', "parameters", 'parameters', "initial_and_parameters", 'initial_and_parameters', NULL]) then _xout := convert(x_classical, 'string'); _res := _solnproc(_xout); if _xout = "parameters" then return [seq(_pars[_i] = _res[_i], _i = 1 .. nops(_pars))] elif _xout = "initial_and_parameters" then return [seq(_vars[_i+1] = [_res][1][_i+1], _i = 0 .. _n), seq(_pars[_i] = [_res][2][_i], _i = 1 .. nops(_pars))] else return [seq(_vars[_i+1] = _res[_i+1], _i = 0 .. _n)] end if elif type(_xout, `=`) and member(lhs(_xout), ["initial", 'initial', "parameters", 'parameters', "initial_and_parameters", 'initial_and_parameters', NULL]) then _xout := convert(lhs(x_classical), 'string') = rhs(x_classical); if type(rhs(_xout), 'list') then _res := _solnproc(_xout) else error "initial and/or parameter values must be specified in a list" end if; if lhs(_xout) = "initial" then return [seq(_vars[_i+1] = _res[_i+1], _i = 0 .. _n)] elif lhs(_xout) = "parameters" then return [seq(_pars[_i] = _res[_i], _i = 1 .. nops(_pars))] else return [seq(_vars[_i+1] = [_res][1][_i+1], _i = 0 .. _n), seq(_pars[_i] = [_res][2][_i], _i = 1 .. nops(_pars))] end if elif type(_xout, `=`) and member(lhs(_xout), ["eventdisable", 'eventdisable', "eventenable", 'eventenable', "eventfired", 'eventfired', "direction", 'direction', NULL]) then return _solnproc(convert(lhs(x_classical), 'string') = rhs(x_classical)) elif _xout = "solnprocedure" then return eval(_solnproc) elif _xout = "sysvars" then return _vars end if; if procname <> unknown then return ('procname')(x_classical) else _ndsol; _ndsol := pointto(_dat[2][0]); return ('_ndsol')(x_classical) end if end if; try _res := _solnproc(_xout); [seq(_vars[_i+1] = _res[_i+1], _i = 0 .. _n)] catch: error  end try end proc

plots:-display([
     plots:-odeplot(Sol, [t, y(t)], t= 0..T, legend= [euler]),

     plot(int(int(f(x), x= 0..t), t= 0..tau), tau= 0..T, legend= [exact], color= black)
]);

 

 

Download dsolve_int_proc.mw

There is hardly any difference in the graphs, so I fail to see the pedagogical value of this exercise.

 


Maple can almost do the integral symbolically: It can do it in exact numeric values if you change your constants to exact values. Once we do that, it is easy to see where the problem is: erf(10) is extremely close to 1; so close that it takes 45 Digits to discern any difference.

 

restart:

eq2:= (a/(a + c*z))^L*exp(-z)/sqrt(z);

L:= 2:
a:= 10^(1/10):  # a:= 10^(0.1);

c:= a/100:  # c:= 0.01*a;

J:= Int(eq2, z= 0..infinity);
'value'('J') = value(J);  

 

 

 

V:= 995*Pi*exp(100)*(erf(10)-1)+100*sqrt(Pi);

995*Pi*exp(100)*(erf(10)-1)+100*Pi^(1/2)

evalf(erf(10));

1.

evalf(100*sqrt(Pi));

177.2453851

evalf(V);

177.2453851

while erf(10.) = 1. do  Digits:= Digits+1  end do:

Digits;

45

Digits:= 45+1+15:

evalf(V): Digits:= 15: evalf(%%);

1.75511537316683

evalf(J);

1.75511537316683

 

 

Download cata_cancel.mw

First 329 330 331 332 333 334 335 Last Page 331 of 395