dharr

Dr. David Harrington

8587 Reputation

22 Badges

21 years, 60 days
University of Victoria
Professor or university staff
Victoria, British Columbia, Canada

Social Networks and Content at Maplesoft.com

Maple Application Center
I am a retired professor of chemistry at the University of Victoria, BC, Canada. My research areas are electrochemistry and surface science. I have been a user of Maple since about 1990.

MaplePrimes Activity


These are answers submitted by dharr

Perhaps I missed something since age 21 in 1968 seems beyond a child. Not a very elegant solution.

"During a birthday party, the birthday child realizes: In 1968, I was the same age as the sum of the digits of my birth year. How old will I be now at the end of 2025?"

restart

Birth year and its sum of digits

b := 1900+10*d1+d2; s := 1+9+d1+d2

1900+10*d1+d2

10+d1+d2

Condition

eq := 1968-b = s

68-10*d1-d2 = 10+d1+d2

Just search

for d1 from 0 to 9 do for d2 from 0 to 9 do if eq then print(d1, d2, eval(2025-b)) end if end do end do

4, 7, 78

So born in 1947, age 21 in 1968 = 1+9+4+7; age in 2025:

2025-1947

78

NULL

Download Birthday.mw

It works using the simplify command rather than the context menu:

restartNULL

 

  k := 10.*Unit('N'/'m')

m := 2.*Unit('kg')NULL

omega := sqrt(k/m)"(->)"2.236067977*Units:-Unit(1/s)

 

"x(t):=A*cos(omega*t)+B*sin(omega*t):"

"v(t):=-A*omega*sin(omega*t)+B*omega*cos(omega*t):"

NULL

L1 := x(0*Unit('s')) = .15*Unit('m')

L2 := v(0*Unit('s')) = 0*Unit('m'/'s')

NULL

s := fsolve({L1, L2}, {A, B}) = {A = .15*Units:-Unit(m), B = -0.}NULL

assign(s)

 

x(t)"(=)".15*Units:-Unit(m)*cos(2.236067977*t*Units:-Unit(1/s))

v(t)

-.3354101966*Units:-Unit(m)*Units:-Unit(1/s^2)^(1/2)*sin(2.236067977*Units:-Unit(1/s^2)^(1/2)*t)

simplify(v(t))

-.3354101966*Units:-Unit(m/s)*sin(2.236067977*t*Units:-Unit(1/s))

v(t)"(=)"-.3354101966*Units:-Unit(m)*sin(2.236067977*t*Units:-Unit(1/s))

``

Download Error_with_units.mw

The change to upright font for D and O appears to be hardcoded into the last step of preparing the output, so diificult to fix (at least for users). 

restart

_local(D, O)

O

a*D*O/sin(D)

a*D*O/sin(D)

The typesetting code for this.
Notice that both a and D are inside Typesetting:-mi(), which is for italics

Typesetting:-Typeset(a*D*O/sin(D)); lprint(%)

a*D*O/sin(D)

Typesetting:-mfrac(Typesetting:-mrow(Typesetting:-mi("a"),Typesetting:-mo(
"⁢"),Typesetting:-mi("D"),Typesetting:-mo("⁢"),
Typesetting:-mi("O")),Typesetting:-mrow(Typesetting:-mi("sin",fontstyle =
"normal"),Typesetting:-mo("⁡"),Typesetting:-mfenced(Typesetting:-
mi("D"))))

Note different output here, suggesting that only in the final stage is there code to force D and O upright.

Typesetting:-mi("D"); Typesetting:-mi("O"); Typesetting:-mi(a)

D

O

a

NULL

Download Typesetting.mw

adding "assuming real" is a workaround for this case.

interface(version);

`Standard Worksheet Interface, Maple 2025.1, Windows 11, June 12 2025 Build ID 1932578`

Physics:-Version();

`The "Physics Updates" package is not available for the version of Maple under development`

SupportTools:-Version();

`The Customer Support Updates package is not installed. To install it, please run the command SupportTools:-Update().`

 

Example fail when using _EnvAllSolutions := true:

 

restart;

kernelopts('assertlevel'=2):

ode:=diff(y(x),x)=ln(1+y(x)^2);
IC:=y(0)=0;
x0:=0;
sol:=y(x) = -sqrt(-1 + exp(RootOf(-Intat(-1/(2*tau*sqrt(-1 + exp(tau))*exp(-tau)), tau = _Z) + x + _C2)));

eq:=0=eval(rhs(sol),x=x0);
_EnvAllSolutions := true:
_EnvExplicit := true:
sol_C:=_C2=solve(eq,_C2);
sol:=eval(sol,sol_C);
odetest(sol,[ode,IC]) assuming real;
simplify(%, symbolic);

diff(y(x), x) = ln(1+y(x)^2)

y(0) = 0

0

y(x) = -(-1+exp(RootOf(-Intat(-(1/2)/(tau*(-1+exp(tau))^(1/2)*exp(-tau)), tau = _Z)+x+_C2)))^(1/2)

0 = -(-1+exp(RootOf(-Intat(-(1/2)/(tau*(-1+exp(tau))^(1/2)*exp(-tau)), tau = _Z)+_C2)))^(1/2)

_C2 = Intat(-(1/2)*exp(tau)/(tau*(-1+exp(tau))^(1/2)), tau = (2*I)*Pi*_Z1)

y(x) = -(-1+exp(RootOf(-Intat(-(1/2)/(tau*(-1+exp(tau))^(1/2)*exp(-tau)), tau = _Z)+x+Intat(-(1/2)*exp(tau)/(tau*(-1+exp(tau))^(1/2)), tau = (2*I)*Pi*_Z1))))^(1/2)

[RootOf(Intat(exp(tau)/(tau*(-1+exp(tau))^(1/2)), tau = _Z)+2*x-Intat(exp(tau)/(tau*(-1+exp(tau))^(1/2)), tau = (2*I)*Pi*_Z1))-ln(exp(RootOf(Intat(exp(tau)/(tau*(-1+exp(tau))^(1/2)), tau = _Z)+2*x-Intat(exp(tau)/(tau*(-1+exp(tau))^(1/2)), tau = (2*I)*Pi*_Z1)))), 0]

[0, 0]

 

Example Works  when using _EnvAllSolutions := false:

 

restart;

kernelopts('assertlevel'=2):

ode:=diff(y(x),x) = ln(1+y(x)^2);
IC:=y(0)=0;
x0:=0;
sol:=y(x) = -sqrt(-1 + exp(RootOf(-Intat(-1/(2*tau*sqrt(-1 + exp(tau))*exp(-tau)), tau = _Z) + x + _C2)));

eq:=0=eval(rhs(sol),x=x0);
_EnvAllSolutions := false:
_EnvExplicit := true:
sol_C:=_C2=solve(eq,_C2);
sol:=eval(sol,sol_C);
odetest(%,[ode,IC])

diff(y(x), x) = ln(1+y(x)^2)

y(0) = 0

0

y(x) = -(-1+exp(RootOf(-Intat(-(1/2)/(tau*(-1+exp(tau))^(1/2)*exp(-tau)), tau = _Z)+x+_C2)))^(1/2)

0 = -(-1+exp(RootOf(-Intat(-(1/2)/(tau*(-1+exp(tau))^(1/2)*exp(-tau)), tau = _Z)+_C2)))^(1/2)

_C2 = Intat(-(1/2)*exp(tau)/(tau*(-1+exp(tau))^(1/2)), tau = 0)

y(x) = -(-1+exp(RootOf(-Intat(-(1/2)/(tau*(-1+exp(tau))^(1/2)*exp(-tau)), tau = _Z)+x+Intat(-(1/2)*exp(tau)/(tau*(-1+exp(tau))^(1/2)), tau = 0))))^(1/2)

[RootOf(Intat(exp(tau)/(tau*(-1+exp(tau))^(1/2)), tau = _Z)+2*x-Intat(exp(tau)/(tau*(-1+exp(tau))^(1/2)), tau = 0))-ln(exp(RootOf(Intat(exp(tau)/(tau*(-1+exp(tau))^(1/2)), tau = _Z)+2*x-Intat(exp(tau)/(tau*(-1+exp(tau))^(1/2)), tau = 0)))), 0]

 

 

Download odetest_fail_when_using_envAllsol_maple_2025_1_oct_21_2025.mw

Is this what you want? Note that when using collect, collecting wrt G{xi) handles negative powers so you do not need to collect wrt 1/G(xi).

restart

with(PDEtools)

undeclare(prime, quiet)

declare(U(xi), quiet)

NULL

ode := -2*(diff(diff(diff(diff(U(xi), xi), xi), xi), xi))*c-(108*c*(1/49)+8*U(xi)^2+1)*(diff(diff(U(xi), xi), xi))+18*U(xi)*(diff(U(xi), xi))^2+2*U(xi)*(-17*U(xi)^2*(1/49)+243*c*(1/2401)+9/98+w)

-2*(diff(diff(diff(diff(U(xi), xi), xi), xi), xi))*c-((108/49)*c+8*U(xi)^2+1)*(diff(diff(U(xi), xi), xi))+18*U(xi)*(diff(U(xi), xi))^2+2*U(xi)*(-(17/49)*U(xi)^2+(243/2401)*c+9/98+w)

S := alpha[0]+alpha[1]*(diff(G(xi), xi))/G(xi)+beta[0]/G(xi)

alpha[0]+alpha[1]*(diff(G(xi), xi))/G(xi)+beta[0]/G(xi)

WW := diff(G(xi), `$`(xi, 2)) = -lambda*G(xi)+mu

diff(diff(G(xi), xi), xi) = -lambda*G(xi)+mu

NULL

D1 := diff(S, xi)

D11 := subs(WW, D1)

D2 := diff(D11, xi)

D22 := subs(WW, D2)

D3 := diff(D22, xi)

D33 := subs(WW, D3)

D4 := diff(D33, xi)

D44 := subs(WW, D4)

K := U(xi) = S

K1 := diff(U(xi), xi) = D11

K2 := diff(diff(U(xi), xi), xi) = D22

K3 := diff(diff(U(xi), xi), xi, xi) = D33

K4 := diff(diff(U(xi), xi), xi, xi, xi) = D44

P := eval(ode, {K, K1, K2, K3, K4})

-2*(alpha[1]*lambda^2*(diff(G(xi), xi))/G(xi)+15*alpha[1]*lambda*(-lambda*G(xi)+mu)*(diff(G(xi), xi))/G(xi)^2-20*alpha[1]*lambda*(diff(G(xi), xi))^3/G(xi)^3-60*alpha[1]*(-lambda*G(xi)+mu)*(diff(G(xi), xi))^3/G(xi)^4+30*alpha[1]*(-lambda*G(xi)+mu)^2*(diff(G(xi), xi))/G(xi)^3+24*alpha[1]*(diff(G(xi), xi))^5/G(xi)^5+24*beta[0]*(diff(G(xi), xi))^4/G(xi)^5-36*beta[0]*(-lambda*G(xi)+mu)*(diff(G(xi), xi))^2/G(xi)^4-8*beta[0]*lambda*(diff(G(xi), xi))^2/G(xi)^3+6*beta[0]*(-lambda*G(xi)+mu)^2/G(xi)^3+beta[0]*lambda*(-lambda*G(xi)+mu)/G(xi)^2)*c-((108/49)*c+8*(alpha[0]+alpha[1]*(diff(G(xi), xi))/G(xi)+beta[0]/G(xi))^2+1)*(-alpha[1]*lambda*(diff(G(xi), xi))/G(xi)-3*alpha[1]*(-lambda*G(xi)+mu)*(diff(G(xi), xi))/G(xi)^2+2*alpha[1]*(diff(G(xi), xi))^3/G(xi)^3+2*beta[0]*(diff(G(xi), xi))^2/G(xi)^3-beta[0]*(-lambda*G(xi)+mu)/G(xi)^2)+18*(alpha[0]+alpha[1]*(diff(G(xi), xi))/G(xi)+beta[0]/G(xi))*(alpha[1]*(-lambda*G(xi)+mu)/G(xi)-alpha[1]*(diff(G(xi), xi))^2/G(xi)^2-beta[0]*(diff(G(xi), xi))/G(xi)^2)^2+2*(alpha[0]+alpha[1]*(diff(G(xi), xi))/G(xi)+beta[0]/G(xi))*(-(17/49)*(alpha[0]+alpha[1]*(diff(G(xi), xi))/G(xi)+beta[0]/G(xi))^2+(243/2401)*c+9/98+w)

We want to find coefficients G^(n)/G^m. collect(P, {1/G(xi), diff(G(xi), xi)}, distributed)collects the way we want, but coeffs does not pick them off correctly (probably because it wasn't intended to work with diff.)

Write Gp for the derivative, and then collect (distributed) on the result.

P2 := subs(diff(G(xi), xi) = Gp, P)

P3 := collect(P2, {Gp, G(xi)}, distributed)

eqs := {coeffs(P3, {Gp, G(xi)}, 'monomials')}

{2*beta[0]^3, -14*alpha[0]*alpha[1]^2, 6*beta[0]^2*alpha[1], 8*beta[0]^3*mu, 4*beta[0]^2*alpha[1]*mu, 4*alpha[0]*alpha[1]^2*lambda-(102/49)*alpha[0]*alpha[1]^2, 18*alpha[0]*alpha[1]^2*lambda^2+2*alpha[0]*(-(17/49)*alpha[0]^2+(243/2401)*c+9/98+w), -80*alpha[1]*lambda*c-2*((108/49)*c+8*alpha[0]^2+1)*alpha[1]+20*alpha[1]^3*lambda-(34/49)*alpha[1]^3, -32*alpha[1]*lambda^2*c-2*((108/49)*c+8*alpha[0]^2+1)*alpha[1]*lambda+18*alpha[1]^3*lambda^2-(68/49)*alpha[0]^2*alpha[1]+2*alpha[1]*(-(17/49)*alpha[0]^2+(243/2401)*c+9/98+w), -60*alpha[1]*mu^2*c+4*beta[0]^2*alpha[1]*lambda+28*beta[0]*alpha[0]*alpha[1]*mu+18*alpha[1]^3*mu^2-(102/49)*beta[0]^2*alpha[1], -56*beta[0]*lambda*c-2*((108/49)*c+8*alpha[0]^2+1)*beta[0]+32*beta[0]*alpha[1]^2*lambda+12*alpha[0]*alpha[1]^2*mu-(102/49)*beta[0]*alpha[1]^2, -12*beta[0]*mu^2*c-8*beta[0]^3*lambda+16*beta[0]^2*alpha[0]*mu+18*beta[0]*alpha[1]^2*mu^2-(34/49)*beta[0]^3, 90*alpha[1]*lambda*mu*c-12*beta[0]*alpha[0]*alpha[1]*lambda+3*((108/49)*c+8*alpha[0]^2+1)*alpha[1]*mu-36*alpha[1]^3*mu*lambda-(204/49)*beta[0]*alpha[0]*alpha[1], -10*beta[0]*lambda^2*c-((108/49)*c+8*alpha[0]^2+1)*beta[0]*lambda+18*beta[0]*alpha[1]^2*lambda^2-36*alpha[0]*alpha[1]^2*mu*lambda+2*beta[0]*(-(17/49)*alpha[0]^2+(243/2401)*c+9/98+w)-(68/49)*alpha[0]^2*beta[0], 22*beta[0]*mu*lambda*c-16*beta[0]^2*alpha[0]*lambda+((108/49)*c+8*alpha[0]^2+1)*beta[0]*mu-36*beta[0]*alpha[1]^2*mu*lambda+18*alpha[0]*alpha[1]^2*mu^2-(102/49)*beta[0]^2*alpha[0], 2*alpha[1]^3-48*c*alpha[1], 6*alpha[1]^2*beta[0]-48*c*beta[0], -16*mu*alpha[1]^2*beta[0]+72*c*mu*beta[0]-14*alpha[0]*beta[0]^2, -12*mu*alpha[1]^3+120*c*mu*alpha[1]-28*alpha[0]*alpha[1]*beta[0]}

monomials

1, Gp^4/G(xi)^4, Gp^4/G(xi)^5, Gp^3/G(xi)^3, Gp^3/G(xi)^4, Gp^3/G(xi)^5, Gp^2/G(xi)^2, Gp^2/G(xi)^3, Gp^2/G(xi)^4, Gp^2/G(xi)^5, Gp/G(xi), Gp/G(xi)^2, Gp/G(xi)^3, Gp/G(xi)^4, 1/G(xi), 1/G(xi)^2, 1/G(xi)^3, 1/G(xi)^4, Gp^5/G(xi)^5

``

NULL

Download system.mw

You had several omissions/errors in the PDE and H,E,X (in red). As usual there doesn't seem a universal method; here one needs to think about the sech/tanh relationship.

Download pp.mw

try params = {k}. If it's not that simple, please upload your worksheet using the Mapleprimes green up-arrow,

I did this before your latest comments, so you may need to alter to suit.

restart;

with(PDEtools, dchange):with(plots):

with(Units):

Automatically loading the Units[Simple] subpackage
 

params:={k= 1.3806490000*10^(-23)*Unit(J/K),rb=5.293*10^(-11)*Unit(m),
ec= 1.602176634*10^(-19)*Unit(C),Tq=1.765*10^(-19)*Unit(s),
c= 299792458*Unit(m/s),T=297*Unit(K),a=1,nu1=7.880979442*10^14*Unit(s^(-1)),E__nu1=8.941594733*10^(-20)*Unit(J)};

{E__nu1 = 0.8941594733e-19*Units:-Unit(J), T = 297*Units:-Unit(K), Tq = 0.1765000000e-18*Units:-Unit(s), a = 1, c = 299792458*Units:-Unit(m/s), ec = 0.1602176634e-18*Units:-Unit(C), k = 0.1380649000e-22*Units:-Unit(J/K), nu1 = 0.7880979442e15*Units:-Unit(1/s), rb = 0.5293000000e-10*Units:-Unit(m)}

N:=8*Pi*Tq^2*nu^2*E(nu)/(c^3*(exp(E(nu)/(k*T)) - 1));V:=Pi*rb^3;

8*Pi*Tq^2*nu^2*E(nu)/(c^3*(exp(E(nu)/(k*T))-1))

Pi*rb^3

Find value and units of NV at nu1 and E__nu1.

NV:=N*V;
eval(eval(NV,{E(nu)=E__nu1,nu=nu1}),params);

8*Pi^2*Tq^2*nu^2*E(nu)*rb^3/(c^3*(exp(E(nu)/(k*T))-1))

0.2546180250e-90*Units:-Unit(s*kg*m^2)

Expected units ??????????? I'll assume NV really has units J*s^3 = s kg m^2. NV has the same units as C

convert(1*Unit(J*s^3/m^3),system,base);

Units:-Unit(kg*s/m)

Non dim energy e=E/kT; non-dim time tau = t/Tg; non dim frequency f=nu*Tq,

So tau*f = t*nu =1

NV2:=eval(NV,{E(nu)=e(f)*k*T, nu=f/Tq});
const:=8*Pi^2*k*T*rb^3/c^3;
NV3:=algsubs(const=C,NV2);

8*Pi^2*f^2*e(f)*k*T*rb^3/(c^3*(exp(e(f))-1))

8*Pi^2*k*T*rb^3/c^3

f^2*e(f)*C/(exp(e(f))-1)

Still rather small

eval(const,params);

0.1781857781e-74*Units:-Unit(s*kg*m^2)

Now we change from frequency to time by a substitution.

NV_tau:=dchange(f=1/tau,NV3);

e(tau)*C/(tau^2*(exp(e(tau))-1))

Difference over 1 period

sol_tau:=NV_tau - eval(NV_tau, tau=tau+1);

e(tau)*C/(tau^2*(exp(e(tau))-1))-e(tau+1)*C/((tau+1)^2*(exp(e(tau+1))-1))

sol_f:=simplify(dchange(tau=1/f,sol_tau));

f^3*e(f)*C*(f+2)/((1+f)^2*(exp(e(f))-1))

Next we differentiation sol_nu wrt nu. dsdnu has units of C*Tq

Diff(sol(nu),nu);
dchange({nu=f/Tq},%,[f],'params'=Tq); # chain rule
dsdnu:=simplify(eval(%,sol(f)=sol_f));

Diff(sol(nu), nu)

(diff(sol(f), f))*Tq

-((1+(e(f)-1)*exp(e(f)))*(1+f)*(f+2)*f*(diff(e(f), f))-2*e(f)*(f^2+3*f+3)*(exp(e(f))-1))*f^2*Tq*C/((1+f)^3*(exp(e(f))-1)^2)

Now we integrate from t = t0 to t0+Tq.
But dsdnu is not a finction of t (?), so this just amounts to multiplying by Tq.
B has same units as C*Tq^2

B:=dsdnu*Tq;

-((1+(e(f)-1)*exp(e(f)))*(1+f)*(f+2)*f*(diff(e(f), f))-2*e(f)*(f^2+3*f+3)*(exp(e(f))-1))*f^2*Tq^2*C/((1+f)^3*(exp(e(f))-1)^2)

The differential equation is sol = B*A or sol-B*A (=0 is assumed by Maple). From a unit point of view A must have same units as 1/Tq^2 = s^(-2). So write A = a/Tq^2, where a is dimensionless.

Just set the numerator zero to simplify the problem. C cancels out, and there is a single dimensionless parameter a

de:=simplify(numer(normal(sol_f - B*a/Tq^2)))/C/f^2;

(1+(e(f)-1)*exp(e(f)))*a*(f+2)*f*(1+f)*(diff(e(f), f))-2*(exp(e(f))-1)*e(f)*(-(1/2)*f^3+(a-3/2)*f^2+(3*a-1)*f+3*a)

No analytical solution

dsolve({de,e(f0)=e0},e(f));

e(f) = RootOf(f-a*ln(f+2)-3*a*ln(f)+2*a*ln(1+f)+a*ln(exp(_Z)-1)-a*ln(_Z)-f0+a*ln(f0+2)+3*a*ln(f0)-2*a*ln(1+f0)-a*ln(exp(e0)-1)+a*ln(e0))

Initial condition and end of frequency range - now numbers seem more reasonable but note exp(e1) is still large.

invals:=eval({f1=nu1*Tq,e1=E__nu1/(k*T),f2=1e18*Unit(s^(-1))*Tq},params);

{e1 = 21.80596196, f1 = 0.1390992872e-3, f2 = .1765000000}

Numerical solution for a=1

sol:=dsolve(eval({de,e(f1)=e1},{a=1} union invals),e(f),numeric,stiff=true);

proc (x_rosenbrock) 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_rosenbrock) else _xout := evalf(x_rosenbrock) end if; _dat := Array(1..4, {(1) = proc (_x_in) local _x_out, _dtbl, _dat, _vmap, _x0, _y0, _val, _digits, _neq, _nevar, _ndisc, _nevt, _pars, _ini, _par, _i, _j, _k, _src, _t1; option `Copyright (c) 2002 by Waterloo Maple Inc. All rights reserved.`; table( [( "complex" ) = false ] ) _x_out := _x_in; _pars := []; _dtbl := array( 1 .. 4, [( 1 ) = (array( 1 .. 28, [( 1 ) = (datatype = float[8], order = C_order, storage = rectangular), ( 2 ) = (datatype = float[8], order = C_order, storage = rectangular), ( 3 ) = ([0, 0, 0, Array(1..0, 1..2, {}, datatype = float[8], order = C_order)]), ( 4 ) = (Array(1..65, {(1) = 1, (2) = 1, (3) = 0, (4) = 0, (5) = 0, (6) = 0, (7) = 1, (8) = 0, (9) = 0, (10) = 0, (11) = 0, (12) = 0, (13) = 0, (14) = 0, (15) = 0, (16) = 0, (17) = 0, (18) = 1, (19) = 30000, (20) = 0, (21) = 0, (22) = 2, (23) = 3, (24) = 0, (25) = 1, (26) = 15, (27) = 1, (28) = 0, (29) = 1, (30) = 3, (31) = 3, (32) = 0, (33) = 2, (34) = 0, (35) = 0, (36) = 0, (37) = 0, (38) = 0, (39) = 0, (40) = 0, (41) = 0, (42) = 0, (43) = 1, (44) = 0, (45) = 0, (46) = 0, (47) = 0, (48) = 0, (49) = 0, (50) = 50, (51) = 1, (52) = 0, (53) = 0, (54) = 0, (55) = 0, (56) = 0, (57) = 0, (58) = 0, (59) = 10000, (60) = 0, (61) = 1000, (62) = 0, (63) = 0, (64) = -1, (65) = 0}, datatype = integer[8])), ( 5 ) = (Array(1..28, {(1) = 0.1390992872e-3, (2) = 0.10e-5, (3) = .0, (4) = 0.500001e-14, (5) = 0.1390992872e-3, (6) = 0.13356737814211669e-4, (7) = .0, (8) = 0.10e-5, (9) = .0, (10) = .0, (11) = .0, (12) = .0, (13) = 1.0, (14) = .0, (15) = .49999999999999, (16) = .0, (17) = 1.0, (18) = 1.0, (19) = .0, (20) = .0, (21) = 1.0, (22) = 1.0, (23) = .0, (24) = .0, (25) = 0.10e-14, (26) = .0, (27) = .0, (28) = .0}, datatype = float[8], order = C_order)), ( 6 ) = (Array(1..1, {(1) = 21.80596196}, datatype = float[8], order = C_order)), ( 7 ) = ([Array(1..4, 1..7, {(1, 1) = .0, (1, 2) = .203125, (1, 3) = .3046875, (1, 4) = .75, (1, 5) = .8125, (1, 6) = .40625, (1, 7) = .8125, (2, 1) = 0.6378173828125e-1, (2, 2) = .0, (2, 3) = .279296875, (2, 4) = .27237892150878906, (2, 5) = -0.9686851501464844e-1, (2, 6) = 0.1956939697265625e-1, (2, 7) = .5381584167480469, (3, 1) = 0.31890869140625e-1, (3, 2) = .0, (3, 3) = -.34375, (3, 4) = -.335235595703125, (3, 5) = .2296142578125, (3, 6) = .41748046875, (3, 7) = 11.480712890625, (4, 1) = 0.9710520505905151e-1, (4, 2) = .0, (4, 3) = .40350341796875, (4, 4) = 0.20297467708587646e-1, (4, 5) = -0.6054282188415527e-2, (4, 6) = -0.4770040512084961e-1, (4, 7) = .77858567237854}, datatype = float[8], order = C_order), Array(1..6, 1..6, {(1, 1) = .0, (1, 2) = .0, (1, 3) = .0, (1, 4) = .0, (1, 5) = .0, (1, 6) = 1.0, (2, 1) = .25, (2, 2) = .0, (2, 3) = .0, (2, 4) = .0, (2, 5) = .0, (2, 6) = 1.0, (3, 1) = .1875, (3, 2) = .5625, (3, 3) = .0, (3, 4) = .0, (3, 5) = .0, (3, 6) = 2.0, (4, 1) = .23583984375, (4, 2) = -.87890625, (4, 3) = .890625, (4, 4) = .0, (4, 5) = .0, (4, 6) = .2681884765625, (5, 1) = .1272735595703125, (5, 2) = -.5009765625, (5, 3) = .44921875, (5, 4) = -0.128936767578125e-1, (5, 5) = .0, (5, 6) = 0.626220703125e-1, (6, 1) = -0.927734375e-1, (6, 2) = .626220703125, (6, 3) = -.4326171875, (6, 4) = .1418304443359375, (6, 5) = -0.861053466796875e-1, (6, 6) = .3131103515625}, datatype = float[8], order = C_order), Array(1..6, {(1) = .0, (2) = .386, (3) = .21, (4) = .63, (5) = 1.0, (6) = 1.0}, datatype = float[8], order = C_order), Array(1..6, {(1) = .25, (2) = -.1043, (3) = .1035, (4) = -0.362e-1, (5) = .0, (6) = .0}, datatype = float[8], order = C_order), Array(1..6, 1..5, {(1, 1) = .0, (1, 2) = .0, (1, 3) = .0, (1, 4) = .0, (1, 5) = .0, (2, 1) = 1.544, (2, 2) = .0, (2, 3) = .0, (2, 4) = .0, (2, 5) = .0, (3, 1) = .9466785280815533, (3, 2) = .25570116989825814, (3, 3) = .0, (3, 4) = .0, (3, 5) = .0, (4, 1) = 3.3148251870684886, (4, 2) = 2.896124015972123, (4, 3) = .9986419139977808, (4, 4) = .0, (4, 5) = .0, (5, 1) = 1.2212245092262748, (5, 2) = 6.019134481287752, (5, 3) = 12.537083329320874, (5, 4) = -.687886036105895, (5, 5) = .0, (6, 1) = 1.2212245092262748, (6, 2) = 6.019134481287752, (6, 3) = 12.537083329320874, (6, 4) = -.687886036105895, (6, 5) = 1.0}, datatype = float[8], order = C_order), Array(1..6, 1..5, {(1, 1) = .0, (1, 2) = .0, (1, 3) = .0, (1, 4) = .0, (1, 5) = .0, (2, 1) = -5.6688, (2, 2) = .0, (2, 3) = .0, (2, 4) = .0, (2, 5) = .0, (3, 1) = -2.4300933568337584, (3, 2) = -.20635991570891224, (3, 3) = .0, (3, 4) = .0, (3, 5) = .0, (4, 1) = -.10735290581452621, (4, 2) = -9.594562251021896, (4, 3) = -20.470286148096154, (4, 4) = .0, (4, 5) = .0, (5, 1) = 7.496443313968615, (5, 2) = -10.246804314641219, (5, 3) = -33.99990352819906, (5, 4) = 11.708908932061595, (5, 5) = .0, (6, 1) = 8.083246795922411, (6, 2) = -7.981132988062785, (6, 3) = -31.52159432874373, (6, 4) = 16.319305431231363, (6, 5) = -6.0588182388340535}, datatype = float[8], order = C_order), Array(1..3, 1..5, {(1, 1) = .0, (1, 2) = .0, (1, 3) = .0, (1, 4) = .0, (1, 5) = .0, (2, 1) = 10.126235083446911, (2, 2) = -7.487995877607633, (2, 3) = -34.800918615557414, (2, 4) = -7.9927717075687275, (2, 5) = 1.0251377232956207, (3, 1) = -.6762803392806898, (3, 2) = 6.087714651678606, (3, 3) = 16.43084320892463, (3, 4) = 24.767225114183653, (3, 5) = -6.5943891257167815}, datatype = float[8], order = C_order)]), ( 9 ) = ([Array(1..1, {(1) = 1.0}, datatype = float[8], order = C_order), Array(1..1, {(1) = .0}, datatype = float[8], order = C_order), Array(1..1, {(1) = .0}, datatype = float[8], order = C_order), Array(1..1, {(1) = .0}, datatype = float[8], order = C_order), Array(1..1, {(1) = -162502067.43793884}, datatype = float[8], order = C_order), Array(1..1, 1..1, {(1, 1) = -49.81617060028293}, datatype = float[8], order = C_order), Array(1..1, 1..1, {(1, 1) = .0}, datatype = float[8], order = C_order), Array(1..1, {(1) = .0}, datatype = float[8], order = C_order), Array(1..1, 1..1, {(1, 1) = .0}, datatype = float[8], order = C_order), Array(1..1, 1..6, {(1, 1) = .0, (1, 2) = .0, (1, 3) = .0, (1, 4) = .0, (1, 5) = .0, (1, 6) = .0}, datatype = float[8], order = C_order), Array(1..1, {(1) = 0}, datatype = integer[8]), Array(1..1, {(1) = .0}, datatype = float[8], order = C_order), Array(1..1, {(1) = .0}, datatype = float[8], order = C_order), Array(1..1, {(1) = .0}, datatype = float[8], order = C_order), Array(1..1, {(1) = .0}, datatype = float[8], order = C_order), Array(1..1, {(1) = .0}, datatype = float[8], order = C_order), Array(1..2, {(1) = .0, (2) = .0}, datatype = float[8], order = C_order), Array(1..1, {(1) = 0}, datatype = integer[8])]), ( 8 ) = ([Array(1..1, {(1) = 21.80596196}, datatype = float[8], order = C_order), Array(1..1, {(1) = .0}, datatype = float[8], order = C_order), Array(1..1, {(1) = -163627977.75921127}, datatype = float[8], order = C_order), 0, 0]), ( 11 ) = (Array(1..6, 0..1, {(1, 1) = .0, (2, 0) = .0, (2, 1) = .0, (3, 0) = .0, (3, 1) = .0, (4, 0) = .0, (4, 1) = .0, (5, 0) = .0, (5, 1) = .0, (6, 0) = .0, (6, 1) = .0}, datatype = float[8], order = C_order)), ( 10 ) = ([proc (N, X, Y, YP) option `[Y[1] = e(f)]`; YP[1] := 2*(exp(Y[1])-1)*Y[1]*(-(1/2)*X^3-(1/2)*X^2+2*X+3)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)*(X+2)*X); 0 end proc, proc (X, Y, FX, FY) FX[1 .. 1] := 0; FY[1 .. 1, 1 .. 1] := 0; FY[1, 1] := 2*exp(Y[1])*Y[1]*(-(1/2)*X^3-(1/2)*X^2+2*X+3)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)*(X+2)*X)+2*(exp(Y[1])-1)*(-(1/2)*X^3-(1/2)*X^2+2*X+3)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)*(X+2)*X)-2*(exp(Y[1])-1)*Y[1]*(-(1/2)*X^3-(1/2)*X^2+2*X+3)*(exp(Y[1])+(Y[1]-1)*exp(Y[1]))/((1+(Y[1]-1)*exp(Y[1]))^2*(X+1)*(X+2)*X); FX[1] := 2*(exp(Y[1])-1)*Y[1]*(-(3/2)*X^2-X+2)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)*(X+2)*X)-2*(exp(Y[1])-1)*Y[1]*(-(1/2)*X^3-(1/2)*X^2+2*X+3)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)^2*(X+2)*X)-2*(exp(Y[1])-1)*Y[1]*(-(1/2)*X^3-(1/2)*X^2+2*X+3)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)*(X+2)^2*X)-2*(exp(Y[1])-1)*Y[1]*(-(1/2)*X^3-(1/2)*X^2+2*X+3)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)*(X+2)*X^2); 0 end proc, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]), ( 13 ) = (), ( 12 ) = (), ( 15 ) = ("rosenbrock"), ( 14 ) = ([0, 0]), ( 18 ) = ([]), ( 19 ) = (0), ( 16 ) = ([0, 0, 0, 0, 0, 0, []]), ( 17 ) = ([proc (N, X, Y, YP) option `[Y[1] = e(f)]`; YP[1] := 2*(exp(Y[1])-1)*Y[1]*(-(1/2)*X^3-(1/2)*X^2+2*X+3)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)*(X+2)*X); 0 end proc, proc (X, Y, FX, FY) FX[1 .. 1] := 0; FY[1 .. 1, 1 .. 1] := 0; FY[1, 1] := 2*exp(Y[1])*Y[1]*(-(1/2)*X^3-(1/2)*X^2+2*X+3)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)*(X+2)*X)+2*(exp(Y[1])-1)*(-(1/2)*X^3-(1/2)*X^2+2*X+3)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)*(X+2)*X)-2*(exp(Y[1])-1)*Y[1]*(-(1/2)*X^3-(1/2)*X^2+2*X+3)*(exp(Y[1])+(Y[1]-1)*exp(Y[1]))/((1+(Y[1]-1)*exp(Y[1]))^2*(X+1)*(X+2)*X); FX[1] := 2*(exp(Y[1])-1)*Y[1]*(-(3/2)*X^2-X+2)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)*(X+2)*X)-2*(exp(Y[1])-1)*Y[1]*(-(1/2)*X^3-(1/2)*X^2+2*X+3)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)^2*(X+2)*X)-2*(exp(Y[1])-1)*Y[1]*(-(1/2)*X^3-(1/2)*X^2+2*X+3)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)*(X+2)^2*X)-2*(exp(Y[1])-1)*Y[1]*(-(1/2)*X^3-(1/2)*X^2+2*X+3)/((1+(Y[1]-1)*exp(Y[1]))*(X+1)*(X+2)*X^2); 0 end proc, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]), ( 22 ) = (0), ( 23 ) = (0), ( 20 ) = ([]), ( 21 ) = (0), ( 27 ) = (""), ( 26 ) = (Array(1..0, {})), ( 25 ) = (Array(1..0, {})), ( 24 ) = (0), ( 28 ) = (0)  ] ))  ] ); _y0 := Array(0..1, {(1) = 0.1390992872e-3}); _vmap := array( 1 .. 1, [( 1 ) = (1)  ] ); _x0 := _dtbl[1][5][5]; _neq := _dtbl[1][4][1]; _nevar := _dtbl[1][4][3]; _ndisc := _dtbl[1][4][4]; _nevt := _dtbl[1][4][16]; if not type(_x_out, 'numeric') then if member(_x_out, ["start", "left", "right"]) then if _Env_smart_dsolve_numeric = true or _dtbl[1][4][10] = 1 then if _x_out = "left" then if type(_dtbl[2], 'array') then return _dtbl[2][5][1] end if elif _x_out = "right" then if type(_dtbl[3], 'array') then return _dtbl[3][5][1] end if end if end if; return _dtbl[1][5][5] elif _x_out = "method" then return _dtbl[1][15] elif _x_out = "storage" then return evalb(_dtbl[1][4][10] = 1) elif _x_out = "leftdata" then if not type(_dtbl[2], 'array') then return NULL else return eval(_dtbl[2]) end if elif _x_out = "rightdata" then if not type(_dtbl[3], 'array') then return NULL else return eval(_dtbl[3]) end if elif _x_out = "enginedata" then return _dtbl[1] elif _x_out = "enginereset" then _dtbl[2] := evaln(_dtbl[2]); _dtbl[3] := evaln(_dtbl[3]); return NULL elif _x_out = "initial" then return procname(_y0[0]) elif _x_out = "laxtol" then return _dtbl[`if`(member(_dtbl[4], {2, 3}), _dtbl[4], 1)][5][18] elif _x_out = "numfun" then return `if`(member(_dtbl[4], {2, 3}), _dtbl[_dtbl[4]][4][18], 0) elif _x_out = "parameters" then return [seq(_y0[_neq+_i], _i = 1 .. nops(_pars))] elif _x_out = "initial_and_parameters" then return procname(_y0[0]), [seq(_y0[_neq+_i], _i = 1 .. nops(_pars))] elif _x_out = "last" then if _dtbl[4] <> 2 and _dtbl[4] <> 3 or _x0-_dtbl[_dtbl[4]][5][1] = 0. then error "no information is available on last computed point" else _x_out := _dtbl[_dtbl[4]][5][1] end if elif _x_out = "function" then if _dtbl[1][4][33]-2. = 0 then return eval(_dtbl[1][10], 1) else return eval(_dtbl[1][10][1], 1) end if elif _x_out = "map" then return copy(_vmap) elif type(_x_in, `=`) and type(rhs(_x_in), 'list') and member(lhs(_x_in), {"initial", "parameters", "initial_and_parameters"}) then _ini, _par := [], []; if lhs(_x_in) = "initial" then _ini := rhs(_x_in) elif lhs(_x_in) = "parameters" then _par := rhs(_x_in) elif select(type, rhs(_x_in), `=`) <> [] then _par, _ini := selectremove(type, rhs(_x_in), `=`) elif nops(rhs(_x_in)) < nops(_pars)+1 then error "insufficient data for specification of initial and parameters" else _par := rhs(_x_in)[-nops(_pars) .. -1]; _ini := rhs(_x_in)[1 .. -nops(_pars)-1] end if; _x_out := lhs(_x_out); _i := false; if _par <> [] then _i := `dsolve/numeric/process_parameters`(_neq, _pars, _par, _y0) end if; if _ini <> [] then _i := `dsolve/numeric/process_initial`(_neq-_nevar, _ini, _y0, _pars, _vmap) or _i end if; if _i then `dsolve/numeric/SC/reinitialize`(_dtbl, _y0, _neq, procname, _pars); if _Env_smart_dsolve_numeric = true and type(_y0[0], 'numeric') and _dtbl[1][4][10] <> 1 then procname("right") := _y0[0]; procname("left") := _y0[0] end if end if; if _x_out = "initial" then return [_y0[0], seq(_y0[_vmap[_i]], _i = 1 .. _neq-_nevar)] elif _x_out = "parameters" then return [seq(_y0[_neq+_i], _i = 1 .. nops(_pars))] else return [_y0[0], seq(_y0[_vmap[_i]], _i = 1 .. _neq-_nevar)], [seq(_y0[_neq+_i], _i = 1 .. nops(_pars))] end if elif _x_in = "eventstop" then if _nevt = 0 then error "this solution has no events" end if; _i := _dtbl[4]; if _i <> 2 and _i <> 3 then return 0 end if; if _dtbl[_i][4][10] = 1 and assigned(_dtbl[5-_i]) and _dtbl[_i][4][9] < 100 and 100 <= _dtbl[5-_i][4][9] then _i := 5-_i; _dtbl[4] := _i; _j := round(_dtbl[_i][4][17]); return round(_dtbl[_i][3][1][_j, 1]) elif 100 <= _dtbl[_i][4][9] then _j := round(_dtbl[_i][4][17]); return round(_dtbl[_i][3][1][_j, 1]) else return 0 end if elif _x_in = "eventstatus" then if _nevt = 0 then error "this solution has no events" end if; _i := [selectremove(proc (a) options operator, arrow; _dtbl[1][3][1][a, 7] = 1 end proc, {seq(_j, _j = 1 .. round(_dtbl[1][3][1][_nevt+1, 1]))})]; return ':-enabled' = _i[1], ':-disabled' = _i[2] elif _x_in = "eventclear" then if _nevt = 0 then error "this solution has no events" end if; _i := _dtbl[4]; if _i <> 2 and _i <> 3 then error "no events to clear" end if; if _dtbl[_i][4][10] = 1 and assigned(_dtbl[5-_i]) and _dtbl[_i][4][9] < 100 and 100 < _dtbl[5-_i][4][9] then _dtbl[4] := 5-_i; _i := 5-_i end if; if _dtbl[_i][4][9] < 100 then error "no events to clear" elif _nevt < _dtbl[_i][4][9]-100 then error "event error condition cannot be cleared" else _j := _dtbl[_i][4][9]-100; if irem(round(_dtbl[_i][3][1][_j, 4]), 2) = 1 then error "retriggerable events cannot be cleared" end if; _j := round(_dtbl[_i][3][1][_j, 1]); for _k to _nevt do if _dtbl[_i][3][1][_k, 1] = _j then if _dtbl[_i][3][1][_k, 2] = 3 then error "range events cannot be cleared" end if; _dtbl[_i][3][1][_k, 8] := _dtbl[_i][3][1][_nevt+1, 8] end if end do; _dtbl[_i][4][17] := 0; _dtbl[_i][4][9] := 0; if _dtbl[1][4][10] = 1 then if _i = 2 then try procname(procname("left")) catch:  end try else try procname(procname("right")) catch:  end try end if end if end if; return  elif type(_x_in, `=`) and member(lhs(_x_in), {"eventdisable", "eventenable"}) then if _nevt = 0 then error "this solution has no events" end if; if type(rhs(_x_in), {('list')('posint'), ('set')('posint')}) then _i := {op(rhs(_x_in))} elif type(rhs(_x_in), 'posint') then _i := {rhs(_x_in)} else error "event identifiers must be integers in the range 1..%1", round(_dtbl[1][3][1][_nevt+1, 1]) end if; if select(proc (a) options operator, arrow; _nevt < a end proc, _i) <> {} then error "event identifiers must be integers in the range 1..%1", round(_dtbl[1][3][1][_nevt+1, 1]) end if; _k := {}; for _j to _nevt do if member(round(_dtbl[1][3][1][_j, 1]), _i) then _k := `union`(_k, {_j}) end if end do; _i := _k; if lhs(_x_in) = "eventdisable" then _dtbl[4] := 0; _j := [evalb(assigned(_dtbl[2]) and member(_dtbl[2][4][17], _i)), evalb(assigned(_dtbl[3]) and member(_dtbl[3][4][17], _i))]; for _k in _i do _dtbl[1][3][1][_k, 7] := 0; if assigned(_dtbl[2]) then _dtbl[2][3][1][_k, 7] := 0 end if; if assigned(_dtbl[3]) then _dtbl[3][3][1][_k, 7] := 0 end if end do; if _j[1] then for _k to _nevt+1 do if _k <= _nevt and not type(_dtbl[2][3][4][_k, 1], 'undefined') then userinfo(3, {'events', 'eventreset'}, `reinit #2, event code `, _k, ` to defined init `, _dtbl[2][3][4][_k, 1]); _dtbl[2][3][1][_k, 8] := _dtbl[2][3][4][_k, 1] elif _dtbl[2][3][1][_k, 2] = 0 and irem(iquo(round(_dtbl[2][3][1][_k, 4]), 32), 2) = 1 then userinfo(3, {'events', 'eventreset'}, `reinit #2, event code `, _k, ` to rate hysteresis init `, _dtbl[2][5][24]); _dtbl[2][3][1][_k, 8] := _dtbl[2][5][24] elif _dtbl[2][3][1][_k, 2] = 0 and irem(iquo(round(_dtbl[2][3][1][_k, 4]), 2), 2) = 0 then userinfo(3, {'events', 'eventreset'}, `reinit #2, event code `, _k, ` to initial init `, _x0); _dtbl[2][3][1][_k, 8] := _x0 else userinfo(3, {'events', 'eventreset'}, `reinit #2, event code `, _k, ` to fireinitial init `, _x0-1); _dtbl[2][3][1][_k, 8] := _x0-1 end if end do; _dtbl[2][4][17] := 0; _dtbl[2][4][9] := 0; if _dtbl[1][4][10] = 1 then procname(procname("left")) end if end if; if _j[2] then for _k to _nevt+1 do if _k <= _nevt and not type(_dtbl[3][3][4][_k, 2], 'undefined') then userinfo(3, {'events', 'eventreset'}, `reinit #3, event code `, _k, ` to defined init `, _dtbl[3][3][4][_k, 2]); _dtbl[3][3][1][_k, 8] := _dtbl[3][3][4][_k, 2] elif _dtbl[3][3][1][_k, 2] = 0 and irem(iquo(round(_dtbl[3][3][1][_k, 4]), 32), 2) = 1 then userinfo(3, {'events', 'eventreset'}, `reinit #3, event code `, _k, ` to rate hysteresis init `, _dtbl[3][5][24]); _dtbl[3][3][1][_k, 8] := _dtbl[3][5][24] elif _dtbl[3][3][1][_k, 2] = 0 and irem(iquo(round(_dtbl[3][3][1][_k, 4]), 2), 2) = 0 then userinfo(3, {'events', 'eventreset'}, `reinit #3, event code `, _k, ` to initial init `, _x0); _dtbl[3][3][1][_k, 8] := _x0 else userinfo(3, {'events', 'eventreset'}, `reinit #3, event code `, _k, ` to fireinitial init `, _x0+1); _dtbl[3][3][1][_k, 8] := _x0+1 end if end do; _dtbl[3][4][17] := 0; _dtbl[3][4][9] := 0; if _dtbl[1][4][10] = 1 then procname(procname("right")) end if end if else for _k in _i do _dtbl[1][3][1][_k, 7] := 1 end do; _dtbl[2] := evaln(_dtbl[2]); _dtbl[3] := evaln(_dtbl[3]); _dtbl[4] := 0; if _dtbl[1][4][10] = 1 then if _x0 <= procname("right") then try procname(procname("right")) catch:  end try end if; if procname("left") <= _x0 then try procname(procname("left")) catch:  end try end if end if end if; return  elif type(_x_in, `=`) and lhs(_x_in) = "eventfired" then if not type(rhs(_x_in), 'list') then error "'eventfired' must be specified as a list" end if; if _nevt = 0 then error "this solution has no events" end if; if _dtbl[4] <> 2 and _dtbl[4] <> 3 then error "'direction' must be set prior to calling/setting 'eventfired'" end if; _i := _dtbl[4]; _val := NULL; if not assigned(_EnvEventRetriggerWarned) then _EnvEventRetriggerWarned := false end if; for _k in rhs(_x_in) do if type(_k, 'integer') then _src := _k elif type(_k, 'integer' = 'anything') and type(evalf(rhs(_k)), 'numeric') then _k := lhs(_k) = evalf[max(Digits, 18)](rhs(_k)); _src := lhs(_k) else error "'eventfired' entry is not valid: %1", _k end if; if _src < 1 or round(_dtbl[1][3][1][_nevt+1, 1]) < _src then error "event identifiers must be integers in the range 1..%1", round(_dtbl[1][3][1][_nevt+1, 1]) end if; _src := {seq(`if`(_dtbl[1][3][1][_j, 1]-_src = 0., _j, NULL), _j = 1 .. _nevt)}; if nops(_src) <> 1 then error "'eventfired' can only be set/queried for root-finding events and time/interval events" end if; _src := _src[1]; if _dtbl[1][3][1][_src, 2] <> 0. and _dtbl[1][3][1][_src, 2]-2. <> 0. then error "'eventfired' can only be set/queried for root-finding events and time/interval events" elif irem(round(_dtbl[1][3][1][_src, 4]), 2) = 1 then if _EnvEventRetriggerWarned = false then WARNING(`'eventfired' has no effect on events that retrigger`) end if; _EnvEventRetriggerWarned := true end if; if _dtbl[_i][3][1][_src, 2] = 0 and irem(iquo(round(_dtbl[_i][3][1][_src, 4]), 32), 2) = 1 then _val := _val, undefined elif type(_dtbl[_i][3][4][_src, _i-1], 'undefined') or _i = 2 and _dtbl[2][3][1][_src, 8] < _dtbl[2][3][4][_src, 1] or _i = 3 and _dtbl[3][3][4][_src, 2] < _dtbl[3][3][1][_src, 8] then _val := _val, _dtbl[_i][3][1][_src, 8] else _val := _val, _dtbl[_i][3][4][_src, _i-1] end if; if type(_k, `=`) then if _dtbl[_i][3][1][_src, 2] = 0 and irem(iquo(round(_dtbl[_i][3][1][_src, 4]), 32), 2) = 1 then error "cannot set event code for a rate hysteresis event" end if; userinfo(3, {'events', 'eventreset'}, `manual set event code `, _src, ` to value `, rhs(_k)); _dtbl[_i][3][1][_src, 8] := rhs(_k); _dtbl[_i][3][4][_src, _i-1] := rhs(_k) end if end do; return [_val] elif type(_x_in, `=`) and lhs(_x_in) = "direction" then if not member(rhs(_x_in), {-1, 1, ':-left', ':-right'}) then error "'direction' must be specified as either '1' or 'right' (positive) or '-1' or 'left' (negative)" end if; _src := `if`(_dtbl[4] = 2, -1, `if`(_dtbl[4] = 3, 1, undefined)); _i := `if`(member(rhs(_x_in), {1, ':-right'}), 3, 2); _dtbl[4] := _i; _dtbl[_i] := `dsolve/numeric/SC/IVPdcopy`(_dtbl[1], `if`(assigned(_dtbl[_i]), _dtbl[_i], NULL)); if 0 < _nevt then for _j to _nevt+1 do if _j <= _nevt and not type(_dtbl[_i][3][4][_j, _i-1], 'undefined') then userinfo(3, {'events', 'eventreset'}, `reinit #4, event code `, _j, ` to defined init `, _dtbl[_i][3][4][_j, _i-1]); _dtbl[_i][3][1][_j, 8] := _dtbl[_i][3][4][_j, _i-1] elif _dtbl[_i][3][1][_j, 2] = 0 and irem(iquo(round(_dtbl[_i][3][1][_j, 4]), 32), 2) = 1 then userinfo(3, {'events', 'eventreset'}, `reinit #4, event code `, _j, ` to rate hysteresis init `, _dtbl[_i][5][24]); _dtbl[_i][3][1][_j, 8] := _dtbl[_i][5][24] elif _dtbl[_i][3][1][_j, 2] = 0 and irem(iquo(round(_dtbl[_i][3][1][_j, 4]), 2), 2) = 0 then userinfo(3, {'events', 'eventreset'}, `reinit #4, event code `, _j, ` to initial init `, _x0); _dtbl[_i][3][1][_j, 8] := _x0 else userinfo(3, {'events', 'eventreset'}, `reinit #4, event code `, _j, ` to fireinitial init `, _x0-2*_i+5.0); _dtbl[_i][3][1][_j, 8] := _x0-2*_i+5.0 end if end do end if; return _src elif _x_in = "eventcount" then if _dtbl[1][3][1] = 0 or _dtbl[4] <> 2 and _dtbl[4] <> 3 then return 0 else return round(_dtbl[_dtbl[4]][3][1][_nevt+1, 12]) end if elif type(_x_in, `=`) and lhs(_x_in) = "setdatacallback" then if not type(rhs(_x_in), 'nonegint') then error "data callback must be a nonnegative integer (address)" end if; _dtbl[1][28] := rhs(_x_in) elif type(_x_in, `=`) and lhs(_x_in) = "Array" then _i := rhs(_x_in); if not type(_i, 'list') or nops(_i) <> 2 or not type(_i[1], 'numeric') or not type(_i[2], 'posint') or _i[2] < 2 then error "Array output must be specified as [end time, min number of points]" end if; _src := array(1 .. 1, [`dsolve/numeric/SC/IVPdcopy`(_dtbl[1])]); if 0 < 0 then if `dsolve/numeric/checkglobals`(op(_src[1][14]), _pars, _neq, _y0) then `dsolve/numeric/SC/reinitialize`(_src, _y0, _neq, procname, _pars, 1) end if end if; if _src[1][4][7] = 0 then error "parameters must be initialized before solution can be computed" end if; _val := `dsolve/numeric/SC/IVPvalues`(_src[1], _x0 .. _i[1], _i[2], _i[2], []); if _val[3] <> "" then `dsolve/numeric/warning`(cat(`requested integration incomplete, received error:`, convert(_val[3], 'symbol'))) end if; _t1 := Array(1 .. _val[2], 0 .. _neq-_nevar+nops(_pars)); _t1[() .. (), 0] := _val[1][1 .. _val[2], 0]; for _i to _neq-_nevar do _t1[() .. (), _i] := _val[1][1 .. _val[2], _vmap[_i]] end do; for _i to nops(_pars) do _t1[() .. (), _neq-_nevar+_i] := _val[1][1 .. _val[2], _neq+_i] end do; return _t1 else return "procname" end if end if; if _x_out = _x0 then return [_x0, seq(evalf(_dtbl[1][6][_vmap[_i]]), _i = 1 .. _neq-_nevar)] end if; _i := `if`(_x0 <= _x_out, 3, 2); if _x_in = "last" and 0 < _dtbl[_i][4][9] and _dtbl[_i][4][9] < 100 then _dat := eval(_dtbl[_i], 2); _j := _dat[4][20]; return [_dat[11][_j, 0], seq(_dat[11][_j, _vmap[_i]], _i = 1 .. _neq-_nevar-_ndisc), seq(_dat[8][1][_vmap[_i]], _i = _neq-_nevar-_ndisc+1 .. _neq-_nevar)] end if; if not type(_dtbl[_i], 'array') then _dtbl[_i] := `dsolve/numeric/SC/IVPdcopy`(_dtbl[1], `if`(assigned(_dtbl[_i]), _dtbl[_i], NULL)); if 0 < _nevt then for _j to _nevt+1 do if _j <= _nevt and not type(_dtbl[_i][3][4][_j, _i-1], 'undefined') then userinfo(3, {'events', 'eventreset'}, `reinit #5, event code `, _j, ` to defined init `, _dtbl[_i][3][4][_j, _i-1]); _dtbl[_i][3][1][_j, 8] := _dtbl[_i][3][4][_j, _i-1] elif _dtbl[_i][3][1][_j, 2] = 0 and irem(iquo(round(_dtbl[_i][3][1][_j, 4]), 32), 2) = 1 then userinfo(3, {'events', 'eventreset'}, `reinit #5, event code `, _j, ` to rate hysteresis init `, _dtbl[_i][5][24]); _dtbl[_i][3][1][_j, 8] := _dtbl[_i][5][24] elif _dtbl[_i][3][1][_j, 2] = 0 and irem(iquo(round(_dtbl[_i][3][1][_j, 4]), 2), 2) = 0 then userinfo(3, {'events', 'eventreset'}, `reinit #5, event code `, _j, ` to initial init `, _x0); _dtbl[_i][3][1][_j, 8] := _x0 else userinfo(3, {'events', 'eventreset'}, `reinit #5, event code `, _j, ` to fireinitial init `, _x0-2*_i+5.0); _dtbl[_i][3][1][_j, 8] := _x0-2*_i+5.0 end if end do end if end if; if _x_in <> "last" then if 0 < 0 then if `dsolve/numeric/checkglobals`(op(_dtbl[1][14]), _pars, _neq, _y0) then `dsolve/numeric/SC/reinitialize`(_dtbl, _y0, _neq, procname, _pars, _i) end if end if; if _dtbl[1][4][7] = 0 then error "parameters must be initialized before solution can be computed" end if end if; _dat := eval(_dtbl[_i], 2); _dtbl[4] := _i; try _src := `dsolve/numeric/SC/IVPrun`(_dat, _x_out) catch: userinfo(2, `dsolve/debug`, print(`Exception in solnproc:`, [lastexception][2 .. -1])); error  end try; if _dat[17] <> _dtbl[1][17] then _dtbl[1][17] := _dat[17]; _dtbl[1][10] := _dat[10] end if; if _src = 0 and 100 < _dat[4][9] then _val := _dat[3][1][_nevt+1, 8] else _val := _dat[11][_dat[4][20], 0] end if; if _src <> 0 or _dat[4][9] <= 0 then _dtbl[1][5][1] := _x_out else _dtbl[1][5][1] := _val end if; if _i = 3 and _val < _x_out then Rounding := -infinity; if _dat[4][9] = 1 then error "cannot evaluate the solution further right of %1, probably a singularity", evalf[8](_val) elif _dat[4][9] = 2 then error "cannot evaluate the solution further right of %1, maxfun limit exceeded (see ?dsolve,maxfun for details)", evalf[8](_val) elif _dat[4][9] = 3 then if _dat[4][25] = 3 then error "cannot evaluate the solution past the initial point, problem may be initially singular or improperly set up" else error "cannot evaluate the solution past the initial point, problem may be complex, initially singular or improperly set up" end if elif _dat[4][9] = 4 then error "cannot evaluate the solution further right of %1, accuracy goal cannot be achieved with specified 'minstep'", evalf[8](_val) elif _dat[4][9] = 5 then error "cannot evaluate the solution further right of %1, too many step failures, tolerances may be too loose for problem", evalf[8](_val) elif _dat[4][9] = 6 then error "cannot evaluate the solution further right of %1, cannot downgrade delay storage for problems with delay derivative order > 1, try increasing delaypts", evalf[8](_val) elif _dat[4][9] = 10 then error "cannot evaluate the solution further right of %1, interrupt requested", evalf[8](_val) elif 100 < _dat[4][9] then if _dat[4][9]-100 = _nevt+1 then error "constraint projection failure on event at t=%1", evalf[8](_val) elif _dat[4][9]-100 = _nevt+2 then error "index-1 and derivative evaluation failure on event at t=%1", evalf[8](_val) elif _dat[4][9]-100 = _nevt+3 then error "maximum number of event iterations reached (%1) at t=%2", round(_dat[3][1][_nevt+1, 3]), evalf[8](_val) else if _Env_dsolve_nowarnstop <> true then `dsolve/numeric/warning`(StringTools:-FormatMessage("cannot evaluate the solution further right of %1, event #%2 triggered a halt", evalf[8](_val), round(_dat[3][1][_dat[4][9]-100, 1]))) end if; Rounding := 'nearest'; _x_out := _val end if else error "cannot evaluate the solution further right of %1", evalf[8](_val) end if elif _i = 2 and _x_out < _val then Rounding := infinity; if _dat[4][9] = 1 then error "cannot evaluate the solution further left of %1, probably a singularity", evalf[8](_val) elif _dat[4][9] = 2 then error "cannot evaluate the solution further left of %1, maxfun limit exceeded (see ?dsolve,maxfun for details)", evalf[8](_val) elif _dat[4][9] = 3 then if _dat[4][25] = 3 then error "cannot evaluate the solution past the initial point, problem may be initially singular or improperly set up" else error "cannot evaluate the solution past the initial point, problem may be complex, initially singular or improperly set up" end if elif _dat[4][9] = 4 then error "cannot evaluate the solution further left of %1, accuracy goal cannot be achieved with specified 'minstep'", evalf[8](_val) elif _dat[4][9] = 5 then error "cannot evaluate the solution further left of %1, too many step failures, tolerances may be too loose for problem", evalf[8](_val) elif _dat[4][9] = 6 then error "cannot evaluate the solution further left of %1, cannot downgrade delay storage for problems with delay derivative order > 1, try increasing delaypts", evalf[8](_val) elif _dat[4][9] = 10 then error "cannot evaluate the solution further right of %1, interrupt requested", evalf[8](_val) elif 100 < _dat[4][9] then if _dat[4][9]-100 = _nevt+1 then error "constraint projection failure on event at t=%1", evalf[8](_val) elif _dat[4][9]-100 = _nevt+2 then error "index-1 and derivative evaluation failure on event at t=%1", evalf[8](_val) elif _dat[4][9]-100 = _nevt+3 then error "maximum number of event iterations reached (%1) at t=%2", round(_dat[3][1][_nevt+1, 3]), evalf[8](_val) else if _Env_dsolve_nowarnstop <> true then `dsolve/numeric/warning`(StringTools:-FormatMessage("cannot evaluate the solution further left of %1, event #%2 triggered a halt", evalf[8](_val), round(_dat[3][1][_dat[4][9]-100, 1]))) end if; Rounding := 'nearest'; _x_out := _val end if else error "cannot evaluate the solution further left of %1", evalf[8](_val) end if end if; if _EnvInFsolve = true then _digits := _dat[4][26]; if type(_EnvDSNumericSaveDigits, 'posint') then _dat[4][26] := _EnvDSNumericSaveDigits else _dat[4][26] := Digits end if; _Env_dsolve_SC_native := true; if _dat[4][25] = 1 then _i := 1; _dat[4][25] := 2 else _i := _dat[4][25] end if; _val := `dsolve/numeric/SC/IVPval`(_dat, _x_out, _src); _dat[4][25] := _i; _dat[4][26] := _digits; [_x_out, seq(_val[_vmap[_i]], _i = 1 .. _neq-_nevar)] else Digits := _dat[4][26]; _val := `dsolve/numeric/SC/IVPval`(eval(_dat, 2), _x_out, _src); [_x_out, seq(_val[_vmap[_i]], _i = 1 .. _neq-_nevar)] end if end proc, (2) = Array(0..0, {}), (3) = [f, e(f)], (4) = []}); _vars := _dat[3]; _pars := map(lhs, _dat[4]); _n := nops(_vars)-1; _solnproc := _dat[1]; if not type(_xout, 'numeric') then if member(x_rosenbrock, ["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_rosenbrock, '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_rosenbrock, ["last", 'last', "initial", 'initial', "parameters", 'parameters', "initial_and_parameters", 'initial_and_parameters', NULL]) then _xout := convert(x_rosenbrock, '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_rosenbrock), 'string') = rhs(x_rosenbrock); 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', "Array", 'Array', NULL]) then return _solnproc(convert(lhs(x_rosenbrock), 'string') = rhs(x_rosenbrock)) elif _xout = "solnprocedure" then return eval(_solnproc) elif _xout = "sysvars" then return _vars elif _xout = "Array" then return [op(_vars), op(_pars)] end if; if procname <> unknown then return ('procname')(x_rosenbrock) else _ndsol := 1; _ndsol := _ndsol; _ndsol := pointto(_dat[2][0]); return ('_ndsol')(x_rosenbrock) end if end if; try _res := _solnproc(_xout); [seq(_vars[_i+1] = _res[_i+1], _i = 0 .. _n)] catch: error  end try end proc

odeplot(sol,[f,e(f)],f=eval(f1..f2,invals),labels=[nu/Tq,E/k/T]);

 

NULL

Download plm3.mw

It's not entirely clear what you want. This can be modified if it is not what you want.

restart

List of characters to choose from

L := [seq("@#$SDFA35")]; n := nops(L)

["@", "#", "$", "S", "D", "F", "A", "3", "5"]

9

Random number generator to pick a number between 1 and n

r := rand(1 .. n)

Choose three characters

q := 3

3

cat(op(L[[seq(r(), 1 .. q)]]))

"AF#"

So to do it k times

k := 4; [seq(cat(op(L[[seq(r(), 1 .. q)]])), 1 .. k)]

4

["SFD", "@3D", "##S", "3$5"]

As a procedure

rands := proc(s::string, k::posint, q::posint)
  local L, r, n;
  L := [seq(s)];
  n := nops(L);
  r := rand(1 .. n);
  [seq(cat(op(L[[seq(r(), 1 .. q)]])), 1 .. k)]
end proc:
  
  

rands("qs4K*N$", 4, 3)

["s*K", "*Ns", "4$s", "NKq"]

NULL

Download rands.mw

According to the text, Eq (1) has nonlinear terms. But the linear/non-linear test in pde-condition.mw says all terms are linear. That test finds it linear because if you double the function you are solving for, you double the pde. That would be consistent with the usual practice in say, second order ODEs like the Bessel equation, where multiplying y(x) by a function of x does not make it a nonlinear equation, but multiplying by a function of y(x) would.

This is the source of your problem finding R. When you choose a form u = R*ln(f)_x and substitute it into the pde, you get R*(something)=0; since the PDE is linear, multiplying it by R leads to R*pde=0 and solving for R gives zero (the pde part is zero but Maple doesn't know that).

So what is the definition of linear/non-linear that you want?

[Edit @acer had some better code for linear/nonlinear parts - maybe that already works for what you want? [moderator: example] ]

Unless I've mistyped something, it looks like the paper is wrong. It is possible the complicated lambda[0] that Maple gives can be simplified to something similar to the lambda[0] in the paper (different sign perhaps), but I don't see it immediately.

restart

with(PDEtools)

with(LinearAlgebra)

with(Physics)

with(SolveTools)

undeclare(prime)

`There is no more prime differentiation variable; all derivatives will be displayed as indexed functions`

ode := (diff(G(xi), xi))^2 = lambda[0]+lambda[1]*G(xi)+lambda[2]*G(xi)^2+lambda[3]*G(xi)^3+lambda[4]*G(xi)^4

(diff(G(xi), xi))^2 = lambda[0]+lambda[1]*G(xi)+lambda[2]*G(xi)^2+lambda[3]*G(xi)^3+lambda[4]*G(xi)^4

ode1 := subs({lambda[1] = 0, lambda[3] = 0}, ode)

(diff(G(xi), xi))^2 = lambda[0]+lambda[2]*G(xi)^2+lambda[4]*G(xi)^4

S2 := G(xi) = sqrt(-aleph^2/((-aleph^2+2)*lambda[4]))*JacobiDN(sqrt(lambda[2]/(-aleph^2+2))*xi, aleph)

G(xi) = (-aleph^2/((-aleph^2+2)*lambda[4]))^(1/2)*JacobiDN((lambda[2]/(-aleph^2+2))^(1/2)*xi, aleph)

res2 := `assuming`([odetest(S2, ode1)], [lambda[2] > 0, lambda[4] < 0]); eq2 := `assuming`([lambda[0] = simplify(solve(res2, lambda[0]))], [lambda[2] > 0, lambda[4] < 0])

-JacobiSN((-lambda[2]/(aleph^2-2))^(1/2)*xi, aleph)^4*aleph^8/(lambda[4]*(aleph^4-4*aleph^2+4))+JacobiSN((-lambda[2]/(aleph^2-2))^(1/2)*xi, aleph)^4*aleph^6*lambda[2]/(lambda[4]*(aleph^4-4*aleph^2+4))+2*JacobiSN((-lambda[2]/(aleph^2-2))^(1/2)*xi, aleph)^2*aleph^6/(lambda[4]*(aleph^4-4*aleph^2+4))-2*JacobiSN((-lambda[2]/(aleph^2-2))^(1/2)*xi, aleph)^2*aleph^4*lambda[2]/(lambda[4]*(aleph^4-4*aleph^2+4))-aleph^4*lambda[0]/(aleph^4-4*aleph^2+4)-aleph^4*lambda[2]/(lambda[4]*(aleph^4-4*aleph^2+4))-aleph^4/(lambda[4]*(aleph^4-4*aleph^2+4))+4*aleph^2*lambda[0]/(aleph^4-4*aleph^2+4)+2*lambda[2]*aleph^2/(lambda[4]*(aleph^4-4*aleph^2+4))-4*lambda[0]/(aleph^4-4*aleph^2+4)

lambda[0] = -(aleph^4*(aleph^2-lambda[2])*JacobiSN(lambda[2]^(1/2)*(-1/(aleph^2-2))^(1/2)*xi, aleph)^4+(-2*aleph^4+2*aleph^2*lambda[2])*JacobiSN(lambda[2]^(1/2)*(-1/(aleph^2-2))^(1/2)*xi, aleph)^2+(lambda[2]+1)*aleph^2-2*lambda[2])*aleph^2/(lambda[4]*(aleph^2-2)^2)

`assuming`([odetest(S2, eval(ode1, eq2))], [lambda[2] > 0, lambda[4] < 0])

0

Paper has lambda[0] as

eq3 := lambda[0] = lambda[2]^2*(-aleph^2+1)/(lambda[4]*(-aleph^2+2)^2)

lambda[0] = lambda[2]^2*(-aleph^2+1)/(lambda[4]*(-aleph^2+2)^2)

Check paper version

`assuming`([simplify(odetest(S2, eval(ode1, eq3)))], [lambda[2] > 0, lambda[4] < 0])

-(aleph^2-lambda[2])*(JacobiSN(lambda[2]^(1/2)*(-1/(aleph^2-2))^(1/2)*xi, aleph)^4*aleph^6-2*JacobiSN(lambda[2]^(1/2)*(-1/(aleph^2-2))^(1/2)*xi, aleph)^2*aleph^4+(lambda[2]+1)*aleph^2-lambda[2])/(lambda[4]*(aleph^2-2)^2)

The two lambda[0]'s are not the same;

`assuming`([simplify(eval(lambda[0], eq2)-(eval(lambda[0], eq3)))], [lambda[2] > 0, lambda[4] < 0]); evalf(eval(%, {aleph = 2, xi = 2.4, lambda[2] = -7, lambda[4] = -2}))

-(aleph^2-lambda[2])*(JacobiSN(lambda[2]^(1/2)*(-1/(aleph^2-2))^(1/2)*xi, aleph)^4*aleph^6-2*JacobiSN(lambda[2]^(1/2)*(-1/(aleph^2-2))^(1/2)*xi, aleph)^2*aleph^4+(lambda[2]+1)*aleph^2-lambda[2])/(lambda[4]*(aleph^2-2)^2)

-28.61877034

NULL

Download compare.mw

The following works except for the indexed names where the index is a constant, such as m[e]. Probably I would consider assigning these to variables m__e rather than m['e'] and always needing the uneval quotes.

Using the constants

restart

with(ScientificConstants)

GetConstants()

`A[r](alpha)`, `A[r](d)`, `A[r](e)`, `A[r](h)`, `A[r](n)`, `A[r](p)`, E[h], F, G, G[0], K[J], M[Earth], M[Moon], M[Sun], M[u], N[A], Phi[0], R, R[Earth], R[K], R[Moon], R[infinity], V[m], Z[0], a[0], a[e], a[mu], alpha, b, c, c[1, L], c[1], c[2], e, epsilon[0], g, g[e], g[mu], g[n], g[p], gamma[e], gamma[n], gamma[p], gamma_prime[h], gamma_prime[p], h, hbar, k, l[P], lambda[C, mu], lambda[C, n], lambda[C, p], lambda[C, tau], lambda[C], m[P], m[alpha], m[d], m[e], `m[e]/m[mu]`, m[h], m[mu], m[n], m[p], m[tau], `m[tau]c^2`, m[u], mu[0], mu[B], mu[N], mu[d], `mu[d]/mu[e]`, mu[e], `mu[e]/mu[p]`, `mu[e]/mu_prime[p]`, mu[mu], mu[n], `mu[n]/mu_prime[p]`, mu[p], mu_prime[h], `mu_prime[h]/mu_prime[p]`, mu_prime[p], n[0], r[e], sigma, sigma[e], sigma_prime[p], t[P]

L := [c, e, hbar, epsilon[0], alpha, m['e']]

[c, e, hbar, epsilon[0], alpha, m[e]]

nops(L)

6

for j to nops(L) do assign(L[j] = GetValue(Constant(L[j]))*GetUnit(Constant(L[j]))) end do

Error, (in ScientificConstants:-Constant) Constant `m[.1602176620e-18*Units:-Unit(C)]` is not known

NULL

L

[299792458*Units:-Unit(m/s), 0.1602176620e-18*Units:-Unit(C), 0.1054571800e-33*Units:-Unit(m^2*kg/s), (625000/22468879468420441)*Units:-Unit(A^2*s^4/(m^3*kg))/Pi, 0.7297352566e-2, m[0.1602176620e-18*Units:-Unit(C)]]

c

299792458*Units:-Unit(m/s)

NULL

epsilon[0]

(625000/22468879468420441)*Units:-Unit(A^2*s^4/(m^3*kg))/Pi

``

m[e]

m[0.1602176620e-18*Units:-Unit(C)]

m['e']

m[e]

m['e'] := GetValue(Constant(m['e']))*GetUnit(Constant(m['e']))

0.9109383560e-30*Units:-Unit(kg)

m['e']

0.9109383560e-30*Units:-Unit(kg)

NULL

Download Using_the_constants_.mw

indets(..., name(assignable)) is very useful for finding the "real" variables in an expression, i.e., those to which you could assign a value, without also capturing other unwanted symbols such as Pi, infinity, undefined.

restart;

K:=2*x+I*y/Pi+Catalan*5-g(infinity)+f(undefined);

2*x+I*y/Pi+5*Catalan-g(infinity)+f(undefined)

indets(K,name(assignable));

{x, y}

Download indets.mw

If you make a larger size plot using size=[1000,1000] then you can get minimal overlap. The orientation of the plot differs each time you hit enter on the DrawGraph command, and that influences the amount of overlap, so you want to repeat until you get a nice result. Then exporting with the right-click menu to prn gives you a 1000x1000 pixel image.

Download DrawGraph.mw

This is the  output prn file:

Here I removed the singularity by multiplying by the denominator and so derived Eq. 9. Is that what you wanted or were you looking for something more? Maybe the ConservedCurrents would work after a while. But the condition in the paper does not seem to be satisfied by alpha[5]=0, n=2/3.

For the equilibria, if you don't like the complicated solutions, I think you will just have to give the parameters some numerical values and use fsolve.

restart

with(PDEtools)

with(plots)

with(plots):

with(DEtools):

undeclare(prime, quiet)

with(LinearAlgebra)

NULL

ode := n*Omega(xi)*(2*alpha[6]*n*Omega(xi)^2+alpha[5]*n*Omega(xi)+beta)*(diff(diff(Omega(xi), xi), xi))+(2*alpha[6]*n^2*Omega(xi)^2-beta*(n-1))*(diff(Omega(xi), xi))^2-n^2*Omega(xi)^2*(-alpha[4]*Omega(xi)^4-alpha[3]*Omega(xi)^3+beta*k^2-Omega(xi)^2*alpha[2]-Omega(xi)*alpha[1]+w) = 0

n*Omega(xi)*(2*alpha[6]*n*Omega(xi)^2+alpha[5]*n*Omega(xi)+beta)*(diff(diff(Omega(xi), xi), xi))+(2*alpha[6]*n^2*Omega(xi)^2-beta*(n-1))*(diff(Omega(xi), xi))^2-n^2*Omega(xi)^2*(-alpha[4]*Omega(xi)^4-alpha[3]*Omega(xi)^3+beta*k^2-Omega(xi)^2*alpha[2]-Omega(xi)*alpha[1]+w) = 0

#Typesetting:-Settings(prime=xi):
#Typesetting:-Settings(typesetprime=true):

I don't know why Q, QP doesn't work here, but you need to specify otherwise it is hard to work with the escaped locals Y and YP chosen by default.

raw := DEtools[convertsys]({ode}, {}, Omega(xi), xi, s, QP, QP)[1..2];

[[QP[1] = s[2], QP[2] = (-(2*alpha[6]*n^2*s[1]^2-beta*(n-1))*s[2]^2+n^2*s[1]^2*(-alpha[4]*s[1]^4-alpha[3]*s[1]^3+beta*k^2-alpha[2]*s[1]^2-alpha[1]*s[1]+w))/(n*s[1]*(2*n*alpha[6]*s[1]^2+n*alpha[5]*s[1]+beta))], [s[1] = Omega(xi), s[2] = diff(Omega(xi), xi)]]

Extract the denominator and scale the right hand sides by it

den:=denom(eval(QP[2],raw[1]));
raw_eta:=map(q->rhs(q)*den,raw[1]);

n*s[1]*(2*n*alpha[6]*s[1]^2+n*alpha[5]*s[1]+beta)

[s[2]*n*s[1]*(2*n*alpha[6]*s[1]^2+n*alpha[5]*s[1]+beta), -(2*alpha[6]*n^2*s[1]^2-beta*(n-1))*s[2]^2+n^2*s[1]^2*(-alpha[4]*s[1]^4-alpha[3]*s[1]^3+beta*k^2-alpha[2]*s[1]^2-alpha[1]*s[1]+w)]

Back to the real transformed variables, which are now in terms of eta.

rhs_eta := eval(raw_eta, {s[1] = Omega(eta), s[2] = y(eta)})

[y(eta)*n*Omega(eta)*(2*alpha[6]*n*Omega(eta)^2+alpha[5]*n*Omega(eta)+beta), -(2*alpha[6]*n^2*Omega(eta)^2-beta*(n-1))*y(eta)^2+n^2*Omega(eta)^2*(-alpha[4]*Omega(eta)^4-alpha[3]*Omega(eta)^3+beta*k^2-Omega(eta)^2*alpha[2]-Omega(eta)*alpha[1]+w)]

Find equilibrium points - one is at the origin; the others are a complicated mess.

equilibria := [solve(rhs_eta, {Omega(eta), y(eta)}, explicit)]; nops(%)

9

Eq 9.

de1 := diff(Omega(eta), eta) = rhs_eta[1]; de2 := diff(y(eta), eta) = rhs_eta[2]

diff(Omega(eta), eta) = y(eta)*n*Omega(eta)*(2*alpha[6]*n*Omega(eta)^2+alpha[5]*n*Omega(eta)+beta)

diff(y(eta), eta) = -(2*alpha[6]*n^2*Omega(eta)^2-beta*(n-1))*y(eta)^2+n^2*Omega(eta)^2*(-alpha[4]*Omega(eta)^4-alpha[3]*Omega(eta)^3+beta*k^2-Omega(eta)^2*alpha[2]-Omega(eta)*alpha[1]+w)

#now we need to construct conservative quantity

Following is too slow, but might work.

We want the condition diff(P,Omega) = -diff(Q,y), so we want the following to be zero

cons_eq := Physics:-diff(rhs_eta[1], Omega(eta))+Physics:-diff(rhs_eta[2], y(eta))

y(eta)*n*(2*alpha[6]*n*Omega(eta)^2+alpha[5]*n*Omega(eta)+beta)+y(eta)*n*Omega(eta)*(4*n*Omega(eta)*alpha[6]+n*alpha[5])-2*(2*alpha[6]*n^2*Omega(eta)^2-beta*(n-1))*y(eta)

According to the paper this is satisfied for alpha[5]=0,n=2/3 but this seems not to be the case.

factor(cons_eq); eval(%, {n = 2/3, alpha[5] = 0})

y(eta)*(2*alpha[6]*n^2*Omega(eta)^2+2*Omega(eta)*alpha[5]*n^2+3*beta*n-2*beta)

(8/9)*y(eta)*alpha[6]*Omega(eta)^2

``

Download bi-1.mw

1 2 3 4 5 6 7 Last Page 1 of 84