mmcdara

I believe this can be done more simply...

Answered: mmcdara 5603

December 03 2023

1 6

There is no need to build the Rough (Rough-Hurwitz) matrix for a polynomial of order 3.
The conditions for its 3 roots have a strictly negative real parts are very simple.

I propose you do the things this way

>

restart

>	with(LinearAlgebra):

>	J := Matrix(3, 3, [[0, 0, -m+Rstar/m], [xi, -1, m-Rstar/m], [0, 1, -m]])

J := Matrix(3, 3, {(1, 1) = 0, (1, 2) = 0, (1, 3) = -m+Rstar/m, (2, 1) = xi, (2, 2) = -1, (2, 3) = m-Rstar/m, (3, 1) = 0, (3, 2) = 1, (3, 3) = -m})

(1)

>	char_poly := CharacteristicPolynomial(J, lambda)

(2)

>	# Coefficients of lambda in char_poly sorted by decreasing powers of lambda c := [coeffs(char_poly, lambda, 'p')]; sort([p]); c := c[sort([p], output=permutation)]

(3)

>	# Condiitons for char_poly to be a Hurwitz polynomial HurwitzConditions := { (c >~ 0)[], c[2]c[3] - c[1]c[4] > 0};

${0 < 1, 0 < Rstar/m, 0 < -xi*(-m^2+Rstar)/m, 0 < 1+m, 0 < xi*(-m^2+Rstar)/m+Rstar*(1+m)/m}$

(4)

>	# char_poly is a Hurwitz polynomial iif sol := {solve(HurwitzConditions)}: print~(%):

${xi = -m-1, 0 < m, m^2 < Rstar}$

${0 < m, 0 < xi, Rstar < m^2, xi*m^2/(xi+m+1) < Rstar}$

${0 < m, Rstar < xi*m^2/(xi+m+1), xi < -m-1, m^2 < Rstar}$

${0 < m, xi < 0, m^2 < Rstar, -m-1 < xi}$

${-1 < m, Rstar < xi*m^2/(xi+m+1), m < 0, xi < 0, -m-1 < xi}$

(5)

>

# Check that random choices of (m, xi, Rstar) which verifie sol[2] lead
# to characteristic polynomials whose roots have a negative real part.

ind := indets(sol):

K    := 1:
sol[K];
V    := {m = rand(0.0 .. 1.)()}:
W    := select(has, eval(sol[K], V), ind):
V    := V union select(type, W, `=`):
W    := select(has, eval(sol[K], V), ind):
V    := V union {Rstar = rand(lhs(W[1])..2*lhs(W[1]))()};

eval(char_poly, V):
evalf([solve(%)]):
Re~(%);

${xi = -m-1, 0 < m, m^2 < Rstar}$

(6)

>

# Check that random choices of (m, xi, Rstar) which verifie sol[2] lead
# to characteristic polynomials whose roots have a negative real part.

ind := indets(sol):

K    := 2:
sol[K];
V    := {m = rand(0.0 .. 1.)(), xi = rand(0.0 .. 1.)()}:
W    := select(has, eval(sol[K], %), ind):
V    := V union {Rstar = rand(lhs(W[1])..rhs(W[2]))()};

eval(char_poly, V):
evalf([solve(%)]):
Re~(%);

${0 < m, 0 < xi, Rstar < m^2, xi*m^2/(xi+m+1) < Rstar}$

(7)

>

# Check that random choices of (m, xi, Rstar) which verifie sol[3] lead
# to characteristic polynomials whose roots have a negative real part.

ind := indets(sol):

K    := 3:
sol[K];
V    := {m = rand(0.0 .. 1.)()}:
W    := select(has, eval(sol[K], V), ind):
V    := V union {xi = rand(2*rhs(W[3])..rhs(W[3]))()}:
W    := select(has, eval(sol[K], V), ind):
V    := V union {Rstar = rand(lhs(W[1])..rhs(W[2]))()};

eval(char_poly, V):
evalf([solve(%)]):
Re~(%);

${0 < m, Rstar < xi*m^2/(xi+m+1), xi < -m-1, m^2 < Rstar}$

(8)

>

# Check that random choices of (m, xi, Rstar) which verifie sol[4] lead
# to characteristic polynomials whose roots have a negative real part.

ind := indets(sol):

K    := 4:
sol[K];
V    := {m = rand(0.0 .. 1.)()}:
W    := select(has, eval(sol[K], V), ind):
V    := V union {xi = rand(lhs(W[1])..rhs(W[3]))()}:
W    := select(has, eval(sol[K], V), ind):
V    := V union {Rstar = rand(lhs(W[1])..2*lhs(W[1]))()};

eval(char_poly, V):
evalf([solve(%)]):
Re~(%);

${0 < m, xi < 0, m^2 < Rstar, -m-1 < xi}$

(9)

>

# Check that random choices of (m, xi, Rstar) which verifie sol[5] lead
# to characteristic polynomials whose roots have a negative real part.

ind := indets(sol):

K    := 5:
sol[K];
V    := {m = rand(-1.0 .. 0.)()};
W    := select(has, eval(sol[K], V), ind);
V    := V union {xi = rand(lhs(W[1])..rhs(W[3]))()};
W    := select(has, eval(sol[K], V), ind);
V    := V union {Rstar = rand(2*rhs(W[1])..rhs(W[1]))()};

eval(char_poly, V):
evalf([solve(%)]):
Re~(%);

${-1 < m, Rstar < xi*m^2/(xi+m+1), m < 0, xi < 0, -m-1 < xi}$

(10)

Download Hurwitz_mmcdara.mw

One way...

Answered: mmcdara 5603

December 02 2023

2 0

restart:
lst := [24300, 18907875, 151200, 147000]:

ilst := map(ifactor, lst);
     [   2    5    2     2    3    5     5    3    2         3       3   2]
     [(2)  (3)  (5) , (3)  (5)  (7) , (2)  (3)  (5)  (7), (2) (3) (5) (7) ]

xlst := eval(ilst, ``(2)=``(x))
     [   2    5    2     2    3    5     5    3    2         3       3   2]
     [(x)  (3)  (5) , (3)  (5)  (7) , (x)  (3)  (5)  (7), (x) (3) (5) (7) ]

One_way.mw

To understand why this works use lprint:

lprint(ilst[1])
``(2)^2*``(3)^5*``(5)^2

As (2)^p is ``(2)^p ( `` prevents the evaluation), just replace ``(2) by ``(x) ( ``(x) will preserve the representation (x)^p)

To retrieve the numbers:

expand(xlst)
             [      2                  5         3]
             [6075 x , 18907875, 4725 x , 18375 x ]

Check your indices...

Answered: mmcdara 5603

December 01 2023

1 0

Three errors:

You define delta(k) at the top of your worksheet but use delta[k] further on.
You use sum instead of add.
You did some mistake in the indices of Theta in the loop.

>

restart; _local(gamma, delta, Zeta)

>

Theta[0] := 1:

>

for k from 0 to 7 do Theta[k+2] := -(beta*add((k-r+1)*Theta[k-r+1]*(r+1)*Theta[r+1], r = 0 .. k)+beta*add(Theta[k-r]*(r+1)*(r+2)*Theta[r+2], r = 0 .. k)+beta*add(add(Theta[r-m]*(k-r+1)*Theta[k-r+1]/(1+delta[m-1]), m = 0 .. r), r = 0 .. k)+add((k-r+1)*Theta[k-r+1]/(1+delta[r-1]), r = 0 .. k)-2*lambda*Theta[k])/((k+1)*(k+2)) end do

Error, too many levels of recursion

>

# For k=0 the computation of T2 is responsible of the error.
# When r=0 you invoke Theta[r+2]= Theta[2]=Theta[k+2] (being processed) for k=2.
#
# Check your indices.

for k from 0 to 7 do
  Theta_Indices_in_T1 := seq([k-r+1, r+1], r = 0 .. k);
  T1 := beta*add((k-r+1)*Theta[k-r+1]*(r+1)*Theta[r+1], r = 0 .. k);
  Theta_Indices_in_T2 := seq([k-r, r+2], r = 0 .. k);
  T2 := beta*add(Theta[k-r]*(r+1)*(r+2)*Theta[r+2], r = 0 .. k);

  T3 := beta*add(add(Theta[r-m]*(k-r+1)*Theta[k-r+1]/(1+delta[m-1]), m = 0 .. r), r = 0 .. k);

  T4 :=add((k-r+1)*Theta[k-r+1]/(1+delta[r-1]), r = 0 .. k)-2*lambda*Theta[k];

  Theta[k+2] := -1/((k+1)*(k+2))*(T1+T2+T3+T4)
end do;

Error, too many levels of recursion

>

Download AF_mmcdara.mw

My advice: Verify the expressions of Theta[k+2]

Non convergent Taylor expansion in the r...

Answered: mmcdara 5603

December 01 2023

3 0

The radius of convergence of function tanh being Pi/2, there necessarily exists a finite range for xx and yy outside of which the Taylor expansion doesn't converge whatever the nuimber of terms you use.

This is reason why your plot (and @dharr's) exhibit sush large values.

More of this, given that the range for yy where h (@dharr's g) has significant variations (obviously h has values in (0, 1); along xx the variations of h are smaller) is 0.5512527188e-1 .. 0.5569069537e-1 (definition given in the file [BL, BR]), you can simplify f by taking only a 6 terms, not the one hundred you manipulate.

All the details are in the attached file.

So, to answeer your question

"Why Taylor series can not estimate my function in desired interval [-1<x,y<1]?"

" Because your are not in the range where this expansion converges"

The convergence range is

yy = 0.55291125973999346567e-1 .. 0.55524841270134109157e-1

The xx convergence range is likely larger for the reason I gave below (slow variations in the xx direction). A rough estimation is

fsolve(g(eval(f0, yy=AT))=0.001) .. fsolve(g(eval(f0, yy=AT))=0.999);
        -3.3962547 .. 0.1126052

>

>	with(Student[MultivariateCalculus]):

>

>	# Preliminaries f0 := evalf(f): g := phi -> .5*(1+tanh(phi)): # note that 0 <= g(..) <= 1 Tf := (n, p, q) -> mtaylor(f0, [xx=p, yy=q], n); Tg := (m, n, p, q) -> mtaylor(g(Tf(n, p, q)), [xx=p, yy=q], m); # examples Tf(5, 0, 0): Tg(4, 5, 0, 0):

(1)

>

# Observe expression g(f0)):

# Observation 1:
#
# As the expression below is numerical equal to 0, and because the min value
# of g(any_function) is 0 too, xx=yy=0 is already extremely far from the
# region where g(..) takes values significantly larger than 0 and lower then 1.

eval(f0, [xx=0, yy=0]);
g(%);

(2)

>

# Observation 2:
#
# Can we get an approximation of where the previous region takes place?
# To do this we search(arbitrarily on the direction <xx, yy=xx> and get

BL := fsolve(eval(g(f0), yy=xx)=0.001);
BR := fsolve(eval(g(f0), yy=xx)=0.999);
plot3d(
  g(f0)
  , xx=BL..BR, yy=BL..BR
  , color = blue
  , style = surface
);

>	# Consider now the taylor expansion of g(f0) around xx = yy = AT # where AT stands for (BL+BR)/2). # # Comparing the values of g(g0) and TG(5, AT, AT) shows a good agreement. AT := (BL+BR)/2; eval(g(f0), [xx=AT, yy=AT]); Tg(5, (BL+BR)/2, (BL+BR)/2): eval(%, [xx=AT, yy=AT]);

(3)

>

# Before computing the Taylor expansion of g(f0), let us
# begin observing how close could be g(f0) and g(Tf(n, AT, AT)).
#
# Taking arbitrarily n=2 already gives a good agreement.
# For more security I will nevertheless use the value n = 3.

plot3d(
  [g(f0), g(Tf(3, AT, AT))]
  , xx=BL..BR, yy=BL..BR
  , color = [blue, red]
  , style = [surface$2]
);

>

# Finally ask yourself theis simple question:
# "Can the Taylor expansion of tanh(x) around x=0 be reasonably acute
#   in the range, let's say -4..4, where on considers than tanh(x)
#   takes values in its almost complete rnge of variation 1..1?@
#
# Let us see:

plot(
  [tanh(x), seq(mtaylor(tanh(x), x, k), k=4..16, 4)]
  , x=-4..4
  , color=[blue, red, orange, cyan, green]
  , legend=[typeset(tanh(x)), seq(cat("k=", k), k=4..16, 4)]
  , view=[default, -2..2]
  , gridlines=true
)

>

# The conclusion is obvious: as no Taylor expansion of tanh(x) gives
# an acceptable representation of tanh(x) outside of a limited range
# (here around -1..1), there is absolutely no chance at all that
# a Taylor expansion og g(f0) will give you a reliable representation
# in a quite limited range around yy=AT (as you see the variation of
# g(f0) is far more rapid along yy than along xx).

# Defining the range where tanh(x) has significant variations this way

SignificantRange := fsolve(tanh(x)=-0.999)..fsolve(tanh(x)=0.999);

# one observes this range extends far from 0 for about 2.4 times the radius of
# convergence of its Taylor expansion.
# Converting this radius of convergence in terms of BR and BL then gives:

xi := (Pi/2) / op(2, SignificantRange);

# and then

ConvergenceRange := AT-(AT-BL)*xi .. AT+(BR-AT)*xi;

g35f3 := Tg(35, 3, AT, AT):

plot3d(
  [g(f0), g35f3]
  , xx=ConvergenceRange, yy=ConvergenceRange
  , color = [blue, red]
  , style = [surface$2]
);

>	# But if push further out from this range PossibleRange := AT-(AT-BL)(xi1.1) .. AT+(BR-AT)(xi1.1); plot3d( [g(f0), g35f3] , xx=PossibleRange, yy=PossibleRange , color = [blue, red] , style = [surface$2] );

Download taylorProblem_mmcdara.mw

Generally speaking things are done in th...

Answered: mmcdara 5603

November 28 2023

1 1

Generally speaking things are done in the other way: starting from an ODE/PDE one derive a numerical scheme which is convergent and consistent with this equation (a fex other properties are required).

The only situation where we start from a discrete equaation (or a set of) and want to buid a continuous ODE/PDE is when you want to answer this question

"I have a continuous ODE/PDE C and its discrete version D, I know that D doesn't represents exactly C and because of some truncation error I would like to tknow what is the continuous ODE/PDE C_true that D represents withe a null truncation error"

See here for a Maple example and the references within.
If you are in this framework please let me know.

Otherwise here is a step by step explanation on how to find a continuous PDE that z11 would discretize:
(do not use "h" and "1" to denote the same space step, firstly it's confusing, and secondly one can get nothing wifh that: use "h" only)

>

(1)

>

U := proc (i, t) options operator, arrow; Matrix([[1+I*(q(i+h, t)-q(i, t))/lambda, I*(r(i+h, t)-r(i, t))/lambda], [I*(r(i+h, t)-r(i, t))/lambda, 1-I*(q(i+h, t)-q(i, t))/lambda]]) end proc:

>

V := proc (i, t) options operator, arrow; Matrix([[-((1/2)*I)*lambda, -r(i, t)], [r(i, t), ((1/2)*I)*lambda]]) end proc:

>

I*(r(i+h, t)^2-r(i, t)^2+(D[2](q))(i+h, t)-(diff(q(i, t), t)))/h = 0

(2)

>	R0, NoR0 := selectremove(has, [op(expand(lhs(z11)))], r); R0, NoR0 := map(add, [R0, NoR0])[]

[I*r(i+h, t)^2/h, -I*r(i, t)^2/h], [I*(D[2](q))(i+h, t)/h, -I*(diff(q(i, t), t))/h]

I*r(i+h, t)^2/h-I*r(i, t)^2/h, -I*(diff(q(i, t), t))/h+I*(D[2](q))(i+h, t)/h

(3)

>	R0 := factor(R0)

(4)

>

# Remark:
#
# The notation f(i+(1/2)*h, t) is commonly ised to represent symbolically the
# mean value of fome function f(x, t) at time t within the interval [i, i+h].
#
# More precisely, in discretization scheme f(i+(1/2)*h, t) is th approximation
# of int(r(x, t), x=i..i+h) got by the mid-point rule.
#
# This strategy, when it comes to a function representing a mass is named
# "mass lumping". This name is used whatever the function f represents
#
# Thus here

MassLumping := r(i+(1/2)*h, t) = ``(r(i+h, t)+r(i, t))/2

(5)

>	# Generally one starts from the continuous equation and then derive a discretization # scheme from it. # For instance, assuming is mass-liming is used, a term such as r(x, t)diff(r(x, t), x) # could be discretized as: r(x, t)diff(r(x, t), x) = r(i+(1/2)*h, t) . ``((r(i+h, t)-r(i, t)) / h);

(6)

>	# Now let's try to buid the continuous PDE from its discretzation # ASSUMING THE MASS-LUMPING STRATEGY IS USED # # Step 1 , for convenience set: I/h = C R0 := algsubs(I/h = C, R0);

(7)

>	# Set 2: FromMassLumping := 2*~(rhs=lhs)(value(MassLumping)); R := subsop(2=rhs(FromMassLumping), R0)

(8)

>	# Set 3: identify the second term in R using a 2nd order Taylor expansion MyRule := op(2, R) = convert(convert(taylor(op(2, R), h, 2), polynom), diff)

(9)

>	# Set 4: use MyRule to rewrite R R := eval(eval(R, C=I/h), MyRule)

(10)

>	# Set 5: use a 1st order expansion of r(i+(1/2)*h, t) as h --> 0 UnlumpedMass := op(-1, R) = convert(taylor(op(-1, R), h, 1), polynom)

(11)

>	# Set 6: use a 1st order expansion of r(i+(1/2)*h, t) as h --> 0 R := eval(R, UnlumpedMass)

(12)

>	# Set 7: finally replace "i" by "x" R := eval(R, i=x)

(13)

>	# Step 8: focus on NoR: # # Basically I apply here some of the same steps as above NoR := algsubs(I/h = C, NoR0); NoR := eval(NoR, i=x); NoR := convert(convert(taylor(NoR, h, 2), polynom), diff); NoR := eval(NoR, C=I/h)

(14)

>	# Step 9: assembling ContinuousPDE := R + NoR

(15)

>

Download ContinuousEquation.mw

I've been stuck several hours until ...

Answered: mmcdara 5603

November 23 2023

2 12

I've been stuck several hours until I saw that the expression of eq I copid-pasted from your file 123.mw was WRONG.
You wrote indeed

eq := a^3*b*T^2*(diff(V(xi), `$`(xi, 2)))+a^3*b*T*(diff(V(xi), xi))+3*a^2*b*V(xi)^2-(3*a*c+2*b*omega)*V(xi)

instead of

eq := a^3*b*xi^2*(diff(V(xi), `$`(xi, 2)))+a^3*b*xi*(diff(V(xi), xi))+3*a^2*b*V(xi)^2-(3*a*c+2*b*omega)*V(xi)

!

Once the corrections are done one can get several solutions among them the two solutions given at formula (3.4) in the image you provide:

>

restart

From equation (3.4)

>	`eq (3.4)` := a^3bxi^2(diff(V(xi), `$`(xi, 2)))+a^3bxi(diff(V(xi), xi))+3a^2bV(xi)^2-(3ac+2bomega)V(xi)

a^3*b*xi^2*(diff(diff(V(xi), xi), xi))+a^3*b*xi*(diff(V(xi), xi))+3*a^2*b*V(xi)^2-(3*a*c+2*b*omega)*V(xi)

(1)

The "constant V" case:

>

# The "constant V" case:
# Let K a non null constant

Cst := factor(eval(`eq (3.4)`, V(xi)=K)):

# K being non nul by definition one keeps onlu

Cst := Cst/K:

# Then Cst is null if

isolate(Cst, omega):

# The special case displayed in the excerpt you reproduce corresponds to K=a/3
# (why this choice?).
map(factor, eval(%, K=a/3))

(2)

The "non constant V" case:

>	verbose := false:

>	Guess := xi -> (p[0]+p[1]xi+p[2]xi^(2)+p[3]xi^(3))/(q[0]+q[1]xi+q[2]xi^(2)+q[3]xi^(3))

proc (xi) options operator, arrow; (p[0]+p[1]*xi+p[2]*xi^2+p[3]*xi^3)/(q[0]+q[1]*xi+q[2]*xi^2+q[3]*xi^3) end proc

(3)

>	# Plug this guess into `eq (3.4)` f := eval(`eq (3.4)`, V=(xi -> Guess(xi))): if verbose then print(f): end if:

>

# Assuming that the denominator doesn't vanish one can concentrate on the numerator of f.
# This numerator is to be seen seen like a polynom with indeterminate xi (9th degree)?
# For it to be identically null whatever xi, it is necessary that all the coefficients
# of this polynom are equal to 0

collect(numer(f), xi):
coefficients := [coeffs(%, xi)]:
if verbose then print(%): end if:

SOL := solve(coefficients):
if verbose then print~({SOL}): end if:

>	SOL := allvalues([SOL]):

>

AllPossibleSolutions := NULL:

for s in map(op, {SOL}) do
  try
   eval(Guess(xi), s):
   AllPossibleSolutions := AllPossibleSolutions, simplify(%);
  catch:
  end try
end do:

AllNonConstantSolutions := {AllPossibleSolutions}:                    # eliminate potential multiple occurrences
AllNonConstantSolutions := select(has, AllNonConstantSolutions, xi): # select non constant guesses
AllNonConstantSolutions := remove(has, AllNonConstantSolutions, I):   # remove possibly complex solutions

print~(AllNonConstantSolutions):

(xi^3*p[3]+xi^2*p[2]+xi*p[1]+p[0])/(xi^3*q[3]+xi^2*q[2]+xi*q[1]+q[0])

(1/3)*(-xi^2*p[3]+4*(p[1]*p[3])^(1/2)*xi-p[1])*a/(xi^2*p[3]+2*(p[1]*p[3])^(1/2)*xi+p[1])

(1/3)*(xi^2*p[3]+4*(p[1]*p[3])^(1/2)*xi+p[1])*a/(-xi^2*p[3]+2*(p[1]*p[3])^(1/2)*xi-p[1])

(1/3)*(6*2^(2/3)*(p[0]^2*p[3])^(2/3)*xi^2+2*p[3]*xi^3*p[0]+9*2^(1/3)*(p[0]^2*p[3])^(1/3)*xi*p[0]+2*p[0]^2)*a/(p[0]*(-2*p[3]*xi^3+3*2^(1/3)*(p[0]^2*p[3])^(1/3)*xi-2*p[0]))

-4*p[2]*a*p[1]*xi/(4*xi^2*p[2]^2-4*xi*p[1]*p[2]+p[1]^2)

4*p[2]*xi*a^2*q[1]/(4*a^2*q[1]^2+4*a*xi*p[2]*q[1]+xi^2*p[2]^2)

(4)

>	# Check the last solution # # Note the result is obviously not 0 eval(`eq (3.4)`, diff=Diff); eval(%, V(xi) = AllNonConstantSolutions[-1]); simplify(value(%));

a^3*b*xi^2*(Diff(Diff(V(xi), xi), xi))+a^3*b*xi*(Diff(V(xi), xi))+3*a^2*b*V(xi)^2-(2*b*omega+3*c*a)*V(xi)

a^3*b*xi^2*(Diff(Diff(4*p[2]*xi*a^2*q[1]/(4*a^2*q[1]^2+4*a*xi*p[2]*q[1]+xi^2*p[2]^2), xi), xi))+a^3*b*xi*(Diff(4*p[2]*xi*a^2*q[1]/(4*a^2*q[1]^2+4*a*xi*p[2]*q[1]+xi^2*p[2]^2), xi))+48*a^6*b*p[2]^2*xi^2*q[1]^2/(4*a^2*q[1]^2+4*a*xi*p[2]*q[1]+xi^2*p[2]^2)^2-4*(2*b*omega+3*c*a)*p[2]*xi*a^2*q[1]/(4*a^2*q[1]^2+4*a*xi*p[2]*q[1]+xi^2*p[2]^2)

4*a^2*xi*p[2]*q[1]*(b*a^3-2*b*omega-3*c*a)/(4*a^2*q[1]^2+4*a*xi*p[2]*q[1]+xi^2*p[2]^2)

(5)

>

# A few words
#
# The first solution is generic and not interesting:
#
# The last solution corresponds to the solution given in equation (3.5)
# once done the transformation {a*q[1] -> q[1], p[2] -> q[2]} (remember a <> 0).
# The previous one is also the solution given in equation (3.5)
# under the transformation p[1] --> q[1] and p[2] --> -q[2]).
#
# I didn't dig into these solutions to understand the meaning of
# AllPossibleSolutions[2..4].

>

# Give a look now to constant solutions

AllConstantSolutions := {AllPossibleSolutions}: # eliminate potential multiple occurrences
AllConstantSolutions := remove(has, AllConstantSolutions, xi): # select non constant guesses
AllConstantSolutions := remove(has, AllConstantSolutions, I): # remove possibly complex solutions

print~(AllConstantSolutions):

(1/3)*(2*b*omega+3*c*a)/(b*a^2)

(6)

>	# A few words # # The first solution is obvious # # The last solution corresponds to the constant olution given in equation (3.5)

>

Download 123_mmcdara_2.mw

It remains a point which puzzles me look to the text in red in the attached file)

It would be interesting to have more information on the paper you cite.
It looks like the non constant solution is the eigen function of the operator which describes lhs(`eq (3.4)`) and the constant solution is the associated eigen value.

Analysis...

Answered: mmcdara 5603

November 23 2023

1 1

@Aung

I don't understand your "can you check please...look like need to determine.constraints..more effectvely?" sentence.

The attached file presents a quick analysis of your problem.
I'm convinced that either your model, or your data, the units you use, are not correct.
By the way, what is this model? It looks like a kind of viscoelasticity model.

>

true_strain := [0, .310734, .720339, 1.15819, 1.68079, 2.18927, 2.75424, 3.26271, 3.81356, 4.32203]:

>

for strain in varepsilon do sigma[strain] := strain/(1.811315924*10^(-11)+.2500000000/(1.010000000*10^10+sum(G[a]*exp(-strain/(strain_rate*tau[a])), a = 1 .. 9))-3.968253968*10^(-12)*nu[12]) end do:

>

stress := [sigma[0.], sigma[0.1500000000e-2], sigma[0.3000000000e-2], sigma[0.4500000000e-2], sigma[0.6000000000e-2], sigma[0.7500000000e-2], sigma[0.9000000000e-2], sigma[0.1050000000e-1], sigma[0.1200000000e-1], sigma[0.1350000000e-1], sigma[0.1500000000e-1]]:

>

(1)

>

constraints := [G[1] <= 0, G[2] <= 0, G[3] <= 0, G[4] <= 0, G[5] <= 0, G[6] <= 0, G[7] <= 0, G[8] <= 0, 1540 <= tau[1], 155260 <= tau[2], 10546880 <= tau[3], 6.000000000*10^8 <= tau[4], 1.080000000*10^10 <= tau[5], 4.040000000*10^11 <= tau[6], 1.100000000*10^13 <= tau[7], 1.080000000*10^14 <= tau[8], 2.040000000*10^16 <= tau[9]];

[G[1] <= 0, G[2] <= 0, G[3] <= 0, G[4] <= 0, G[5] <= 0, G[6] <= 0, G[7] <= 0, G[8] <= 0, 1540 <= tau[1], 155260 <= tau[2], 10546880 <= tau[3], 600000000.0 <= tau[4], 0.1080000000e11 <= tau[5], 0.4040000000e12 <= tau[6], 0.1100000000e14 <= tau[7], 0.1080000000e15 <= tau[8], 0.2040000000e17 <= tau[9]]

(2)

A SIMPLE ANALYSIS

>	# Let's tke for instance stress[5]: s5 := stress[5]

0.6000000000e-2/(0.1700204813e-10+.2500000000/(0.1010000000e11+G[1]*exp(-60./tau[1])+G[2]*exp(-60./tau[2])+G[3]*exp(-60./tau[3])+G[4]*exp(-60./tau[4])+G[5]*exp(-60./tau[5])+G[6]*exp(-60./tau[6])+G[7]*exp(-60./tau[7])+G[8]*exp(-60./tau[8])+G[9]*exp(-60./tau[9])))

(3)

>	# You impose quite large values for the owar bounds of tau. # So s5 is almost equal to s5_1 := eval(s5, {seq(tau[i]=+infinity, i=1..9)})

0.6000000000e-2/(0.1700204813e-10+.2500000000/(0.1010000000e11+1.*G[1]+1.*G[2]+1.*G[3]+1.*G[4]+1.*G[5]+1.*G[6]+1.*G[7]+1.*G[8]+1.*G[9]))

(4)

>	# Assuming that the Gshave almost the same value g one gets s5_2 := normal(eval(s5_1, {seq(G[i]=g, i=1..9)}))

0.6000000000e-2*(0.1010000000e11+9.*g)/(.4217206861+0.1530184332e-9*g)

(5)

>	# s5_2 is singular at singular(s5_2); plot(s5_2, g=-1e10..-1e8)

>	# What is the range of positive values for s5_2? # As you impose the Gs are negative: solve(s5_2 > 0) assuming g < 0; domains := solve({s5_2 > 0, g < 0})

(6)

>	# In the two domains 5_2 is contiously increasing: normal(diff(s5_2, g))

0.1350000000e-1/(.4217206861+0.1530184332e-9*g)^2

(7)

>	# The minium value of s5_2 in domains[1] is s5_2_min_1 := limit(s5_2, g=-infinity); # a value 10^6 times larger than true_stress[5]

(8)

>	# The minium value of s5_2 in domains[1] is s5_2_min_2 := 0; # So if you expect than s5 canbe close to true_stress[5]=191, # it seems reasonable to impose that g verifies domains[2]

(9)

>	# Note that the value of s5_2 are rapidly much higher than 191 in the # range of interest. plot(s5_2, g=lhs(op(1, domains[2]))..0, axis[2]=[mode=log])

>	# When is s5_2 equal to true_stress[5]? solve({s5_2 = true_stress[5], domains[2][]})

(10)

>

# Now, assuming each tau is large enough for the limit tau -> +oo
# is reasonable, lets define this simplified problem

ObjLimit := eval(obj, {seq(tau[i]=+infinity, i=1..9)}):

# And, all the G[1],.., G[9] only intervene through their sum SG, set:

ObjSimple := algsubs(add(1.*G[i], i=1..9) = SG, ObjLimit):

ObjSimple := simplify(ObjSimple, size);

(0.2262907678e39+0.4481007768e29*SG+0.2218321900e19*SG^2)/(SG+0.2480411083e11)^2

(11)

>	# Try to minimize ObjSimple without taking any precautions at all: minimize(ObjSimple, location=true)

(12)

>

# Even for its minimizer ObjSimple gets the amazing high value 10^9.
# Might one reason be the crude approximation tau = +oo?
#
# Let's look to the values of exp(-strain/(strain_rate*tau[a])) for the
# constraints you impose to the taus.

exp(-strain/(strain_rate*tau[a]));

TauMin := {1540 = tau[1], 155260 = tau[2], 10546880 = tau[3], 6.000000000*10^8 = tau[4], 1.080000000*10^10 = tau[5], 4.040000000*10^11 = tau[6], 1.100000000*10^13 = tau[7], 1.080000000*10^14 = tau[8], 2.040000000*10^16 = tau[9]};

eval( [seq([seq(exp(-x/(strain_rate*tau[i])), i=1..9)], x in varepsilon)], (rhs=lhs)~(TauMin)):
print~(%):

exp(-150.0000000/tau[a])

{1540 = tau[1], 155260 = tau[2], 10546880 = tau[3], 600000000.0 = tau[4], 0.1080000000e11 = tau[5], 0.4040000000e12 = tau[6], 0.1100000000e14 = tau[7], 0.1080000000e15 = tau[8], 0.2040000000e17 = tau[9]}

(13)

>

# In ObjSimple I used the value "1" instead of the values above.
# As you can see my approximation is not that crude and cannot be responsible
# of the extremely high value of the minimum of ObjSimple.
#
# So the problem is elsewhere, on the side of your model certainly,
# maybe you should also look on the side of the units you use (are they consistent?)

Download 9terms_mmcdara.mw

LAST COMMENT:
As your model is governed by the sum SG = G[1]+..+G[7] when parameters tau[1]..tau[7] are "large enough" (which is your case),this means your model is not identifiable in the sense that an infinity of
7-uples (G[1], .., G[7]) can give the same value of SG.
Note that tau values are not identifiable neither when the (positive) lower bounds they lust verify are "large enough".

First: convert solution into hyperbolic ...

Answered: mmcdara 5603

November 21 2023

1 3

Next arrange the result the way it suits you (an example is provided at the end of the attached file):

>

restart

>	V := exp(lambdaS) = S^4a4 + S^3a3 + S^2a2 + S*a1 + a0;

>	V1 := subs(S = 2, V);

>	V2 := subs(S = 1, V);

>	V3 := subs(S = 0, V);

>	V4 := subs(S = -1, V);

>	V5 := subs(S = -2, V);

(1)

>	sol := solve(subs(a0 = 1, {V1, V2, V4, V5}), {a1, a2, a3, a4});

{a1 = (2/3)*exp(lambda)-(2/3)*exp(-lambda)-(1/12)*exp(2*lambda)+(1/12)*exp(-2*lambda), a2 = (2/3)*exp(-lambda)-5/4+(2/3)*exp(lambda)-(1/24)*exp(2*lambda)-(1/24)*exp(-2*lambda), a3 = -(1/12)*exp(-2*lambda)-(1/6)*exp(lambda)+(1/6)*exp(-lambda)+(1/12)*exp(2*lambda), a4 = (1/24)*exp(2*lambda)+1/4-(1/6)*exp(lambda)-(1/6)*exp(-lambda)+(1/24)*exp(-2*lambda)}

(2)

>	trigsol := convert~(sol, trigh)

{a1 = (4/3)*sinh(lambda)-(1/6)*sinh(2*lambda), a2 = (4/3)*cosh(lambda)-5/4-(1/12)*cosh(2*lambda), a3 = (1/6)*sinh(2*lambda)-(1/3)*sinh(lambda), a4 = (1/12)*cosh(2*lambda)+1/4-(1/3)*cosh(lambda)}

(3)

>	rel := { sinh(2lambda)=2sinh(lambda)cosh(lambda) , cos(2lambda)=cos(lambda)^2+sin(lambda)^2 }: map(factor, simplify(trigsol, rel))

${a1 = -(1/3)*sinh(lambda)*(cosh(lambda)-4), a2 = -(1/6)*(cosh(lambda)-1)*(cosh(lambda)-7), a3 = (1/3)*sinh(lambda)*(cosh(lambda)-1), a4 = (1/6)*(cosh(lambda)-1)^2}$

(4)

>

Download trigh.mw

The key is to define the rewritting rules rel that will lead you to the desire result.

Some results...

Answered: mmcdara 5603

November 21 2023

4 3

The first point is that your couple of equations (eq1, eq2) cannot be solved formally.

THIS SECTION IS OBSOLETE GIVEN @Christian Wolinski's remark

I kept it however tio justify what @Christian Wolinski wrote

Having said that the natural approach is to give x a numerical value and solve (eq1, eq2) numerically, which will provide you a single solution (if any).

I adopted a different way based on the observation that eq1-eq2 is a polynomial equation which doesn't contain x. Its solution is easily computable, even by hand, and iis of the form y=f(z) where z can be coosed arbitrarily.
Things are a little bit more delicate for eq1-eq2 can be seen as a polynomial of degree 2 and y: then you can get 2 real solutions, a double real solution or 2 conjugate solutions depending on the value of z.

In the attached file I considered that you would be interested by real solutions only. This constraints implies z is to be choosen in some subdomain of the real line (denoted Omega in the worksheet).
Each of the two relations y=f(z) is aimed to be plugged into equation eq1 (the simplest one). Once done the resulting equation, which depends only on z, is formally solved.

The results are of small direct interest as they are represented by a RootOf of a complex expression.
Using the classical command allvalues to force the evaluations of the roots (if any) of this equation still gives extremely complex, and IMO useless, expressions... but evaluating the output of allvalues as floats give, for each relation y=f(z), a collection of numeric z-solutions.
The last step is to compute the corresponding y-solutions by applying f to each z-solution.

An attempt to represent the (y, z)-solutions for different values of x in the range 0..1 is also proposed.

xyz.mw

UPDATED ANSWER

The attached file contains a procedure which is aimed to find (I write this way for it seems that a few solutions are missed, likely for numerical reasons) all the solutions (y(x), z(x)) in a square domain
-L <= y <= L, -L <= z <= L with L strictly positive.

Note that this domain could probably be reduced by ignoring negative y values (I didn't look into this point, but it seems that all solutions verify y > 0... something that is maybe easy to prove).

I only focused here on your claim "I need to find the first 3 or 5 solutions" (in fact this

>

restart

>	eq1 := z(1/150-2y)exp(-2Pixy)+1/5((z^2-y^2)sin(2Pixz)-2yzcos(2Pix*z))=0

(1)

>	eq2 := (z^2-y^2+1/150y-1)exp(-2Pixy)+1/5((z^2-y^2)sin(2Pixz)+2yzcos(2Pixz))=0

(2)

How do I proceed

(1) Principles

>

# As no formal solution (y(x), z(x)) can be found a good start is to
# do some graphics, to understand what happens.

Digits := 15:

X := 0.1;   # my arbitrary choice in [0, 1]

L := 20:
NG := 1000:

pp :=
plots:-implicitplot(
  eval([eq1, eq2], x=X)
  , y=-L..L, z=-L..L
  , color=[red, blue]
  , legend=["eq1=0", "eq2=0"]
  , grid=[NG, NG]
):

(3)

>	# 10 solutions are likely to be seen here plots:-display(pp)

>	NC1 := nops~([op(1, pp)])[]-2; # NC1 red curves NC2 := nops~([op(2, pp)])[]-2; # NC2 blue curves # Matrix representation of each curve AllCurves := map2(op, -1, [plottools:-getdata(pp)]):

(4)

>	# Let J the objective function which is equal to 0 iif eq1 and eq2 areboth # verified (log[10] is an artifact to lessen the range of variation of J) J := log[10](add(lhs~([eq1, eq2])^~2)):

>

# Solution search algorithm

Digits := 15:

SignChanges      := NULL:
minima           := NULL:
SolutionsChecked := NULL:

# For each curve eq1=0
for ac in AllCurves[1..NC1] do
  pts1 := convert(ac, listlist):

  # Find the points on this curve where lhs(eq2) changes its sign
  # (points where a red and a blue curve will tangent will be missed)
  StartSign   := signum(eval(eval(lhs(eq2), x=X), [y, z] =~ pts1[1]));
  for i from 2 to numelems(pts1) do
    EndSign := signum(eval(eval(lhs(eq2), x=X), [y, z] =~ pts1[i]));
    if EndSign <> StartSign then
      StartSign   := EndSign;
      SignChanges := SignChanges, [pts1[max(1, i-2)], pts1[i]]
    end if:
  end do:
end do:
# Each couple of points (y, z) within which a sign change occurs defines
# a domain where to search a solution where J is minimal (theoritically null).
for s in [SignChanges] do
  dom := y = (min..max)(map2(op, 1, s)), z = (min..max)(map2(op, 2, s));
  try
    minima := minima, Optimization:-Minimize(eval(J, x=X), dom, optimalitytolerance=1e-8, iterationlimit=1000):
  catch:
    printf("No solution found in domain %a\n", [dom])
  end try:
end do:

# Evaluate eq1 and eq2 at the minima found.
for sol in [minima] do
  SolutionsChecked := SolutionsChecked, eval(eval(lhs~([eq1, eq2]), x=X), sol[2])
end do:
#print~(map2(op, 2, [minima]) implies~ [SolutionsChecked]):

# Due to numerical precision some minima appear to give significantly non nul solution.
# I arbitrarily discard them.
AlmostSolutions := zip((u, v) -> if `and`(is~(abs~(u) <=~ 1e-5)[]) then v end if, [SolutionsChecked], map2(op, 2, [minima])):
print~(AlmostSolutions):

plots:-display(
  pp,
  seq(
    plot([eval([y, z], AlmostSolutions[i])], style=point, symbol=circle, symbolsize=20, color=black),
    i = 1..numelems(AlmostSolutions)
  )
)

How do I proceed

(2) The solution procedure

>

SearchSolutions := proc(X, L, {see::boolean:=false, verbose::boolean:=false})
  local NG, pp, NC1, NC2, AllCurves, SignChanges, minima, SolutionsChecked,
        ac, pts1, StartSign, i, EndSign, s, dom, sol, AlmostSolutions:

  uses plots:

  NG := 1000:
  pp := implicitplot(
    eval([eq1, eq2], x=X)
    , y=-L..L, z=-L..L
    , color=[red, blue]
    , legend=["eq1=0", "eq2=0"]
    , grid=[NG, NG]
    , title=typeset('x'=X)
  ):

  NC1 := nops~([op(1, pp)])[]-2;
  NC2 := nops~([op(2, pp)])[]-2;

  AllCurves := map2(op, -1, [plottools:-getdata(pp)]):

  SignChanges      := NULL:
  minima           := NULL:
  SolutionsChecked := NULL:

  for ac in AllCurves[1..NC1] do
    pts1        := convert(ac, listlist):
    StartSign   := signum(eval(eval(lhs(eq2), x=X), [y, z] =~ pts1[1]));
    for i from 2 to numelems(pts1) do
      EndSign := signum(eval(eval(lhs(eq2), x=X), [y, z] =~ pts1[i]));
      if EndSign <> StartSign then
        StartSign   := EndSign;
        SignChanges := SignChanges, [pts1[max(1, i-2)], pts1[i]]
      end if:
    end do:
  end do:

  for s in [SignChanges] do
    dom := y = (min..max)(map2(op, 1, s)), z = (min..max)(map2(op, 2, s));
    try
      minima := minima, Optimization:-Minimize(eval(J, x=X), dom, optimalitytolerance=1e-8, iterationlimit=1000):
    catch:
      if verbose then
        printf("X = %3a No solution found in domain %a\n", X, [dom])
      end if;
    end try:
  end do:

  for sol in [minima] do
    SolutionsChecked := SolutionsChecked, eval(eval(lhs~([eq1, eq2]), x=X), sol[2])
  end do:
  AlmostSolutions := zip((u, v) -> if `and`(is~(abs~(u) <=~ 1e-5)[]) then v end if, [SolutionsChecked], map2(op, 2, [minima])):

  if see then
    print(
      plots:-display(
        pp,
        seq(
          plot([eval([y, z], AlmostSolutions[i])], style=point, symbol=circle, symbolsize=20, color=black),
          i = 1..numelems(AlmostSolutions)
        )
      )
    );
    print():
  end if:

  return AlmostSolutions
end proc:

>	SearchSolutions(0.2, 20, see=true)

(5)

>	# Sweep the range 0..1 for x and collect all the solutions found in this range Xs := [seq](0.1..1, 0.1): Sol_wrt_X := table([ seq(xs = SearchSolutions(xs, 20, verbose=true), xs in Xs) ]):

X = .4 No solution found in domain [y = 15.6066929420051 .. 15.6457631113523, z = 15.6245382892261 .. 15.6255081599189]
X = .4 No solution found in domain [y = 11.8689358202139 .. 11.9077186173179, z = 11.8748079235297 .. 11.8760651664658]

X = .5 No solution found in domain [y = 12.4853581013289 .. 12.5244290234156, z = 12.499626883656 .. 12.5005960016093]

X = .8 No solution found in domain [y = 16.5565565565565 .. 16.5965965965966, z = 16.5624419179027 .. 16.5629167275484]

X = .8 No solution found in domain [y = 12.7927927927928 .. 12.8328328328328, z = -12.8127796536036 .. -12.8121695242539]
X = .8 No solution found in domain [y = 5.3053053053053 .. 5.3453453453453, z = 5.31222489410908 .. 5.31366125682572]

X = .8 No solution found in domain [y = .314327082446639 .. .356413032179948, z = -2.59865527442221 .. -2.59660936472894]

X = 1.0 No solution found in domain [y = .4604604604604 .. .5005005005005, z = -10.0192011299064 .. -10.0185580322442]
X = 1.0 No solution found in domain [y = 13.2332332332332 .. 13.2732732732732, z = 13.2497897695701 .. 13.2502623826246]

X = 1.0 No solution found in domain [y = 2.23548973487505 .. 2.27305935450115, z = 2.24899474960935 .. 2.25146517002328]

>

# Plot all the solutions found for each value of X in Xs

plots:-display(
  seq(
    plot(
      [seq](eval([y, z], Sol_wrt_X[k][i]), i = 1..numelems(Sol_wrt_X[k]))
      , style=point
      , symbol=solidcircle
      , symbolsize=10
      , color=ColorTools:-Color([rand()/10^12, rand()/10^12, rand()/10^12])
      , legend=typeset('x'=k)
      , legendstyle=[location=right]
      , labels=[y, z]
    )
    , k in Xs[2..-1]
  )
  , gridlines=true
  , view=[-0.1..20, -20..20]
  , size=[500, 400]
)

>

yz_sol_1.mw

Alternative...

Answered: mmcdara 5603

November 19 2023

0 1

@C_R

If you don't mind having r and t dimensionless:

r := t -> max(t, 0):
plot(r(t), t=-1..2, useunits = [Unit('s'), Unit(('W')/'m'^2)])

solve and plots:-inequal...

Answered: mmcdara 5603

November 19 2023

0 1

Finding the domains where f(x)^2-g(y)^2 > 0 requires knowing explicitely the expressions of f and g, if not you can simply consider the expression a^2-b^2 > 0 instead.

Examples:

>

restart

>	expr := a^2-b^2;

(1)

>	solve(expr >= 0)

(2)

>	plots:-inequal(expr >= 0, a=-3..3, b=-3..3 );

>	f := u -> u^2: g := u -> u/(1+u^2): expr := f(x)^2 - g(y)^2; solve(expr >= 0)

x^4-y^2/(y^2+1)^2

${x < -(-y*(y^2+1))^(1/2)/(y^2+1), y < 0}, {x = -(-y*(y^2+1))^(1/2)/(y^2+1), y < 0}, {x = (-y*(y^2+1))^(1/2)/(y^2+1), y < 0}, {y < 0, (-y*(y^2+1))^(1/2)/(y^2+1) < x}, {x = x, y = 0}, {0 < y, x < -(y*(y^2+1))^(1/2)/(y^2+1)}, {x = -(y*(y^2+1))^(1/2)/(y^2+1), 0 < y}, {x = (y*(y^2+1))^(1/2)/(y^2+1), 0 < y}, {0 < y, (y*(y^2+1))^(1/2)/(y^2+1) < x}$

(3)

>	plots:-inequal(expr >= 0, x=-3..3, y=-3..3 );

>

Download inequality.mw

Boring that you change the answer that d...

Answered: mmcdara 5603

November 14 2023

3 7

This is an answer to your previous question "why solve gives noolution?" or something like that.

The answer is simple: solve can solve systems of 3 polynomial equations in 3 unknowns if each equation contans relatively low degrees of unwkowns combinations.
Beforetryink to use solve, give a look to your equations: it should be clear to you that yoour system cannot be solved in a formal way, that's it.

I end my worksheet with an advice and an example of a numeric solution.
It's up to you to take inspiration of this, or not and keep asking while solve cannot solve your equations.

141123_Problem_mmcdara.mw

About your "reformulated" question:

You write: "Instead of solving my original equations, which are convoluted and not in polynomial form, I try to solve for their numerators first (since their numerators are polynomials). Broadly speaking, such solutions should also solve the original non-polynomial system"
I "solved for the numerators" in the attached file and no formal solution (using solve) could be got.
If you say that the system in your new file can be "solved for the numerators", isn't it because you have simplified your initial problem in somesense (isn't it the meaning of "no correlation" in the name of your new file?).

You write "They need to be verified":
What does "verifying a formal [thus exact] solution" mean to you? Checking that the roots ofthe numerator do not nullify the denominators?
if it is so do that:

num := numer~ (Eqs);
sol := solve(Eqs, Vars,...):  # or SolveTools:-PolynomialSystem maybe
den := denom~(Eqs):
eval(den, sol); # or eval(den, Vars=~sol) 
                # or seq(eval(den, Vars=~s), s in [sol]
                # or somethingelse depending on the structure of sol

Here is an example where the olution (named sol_solve) has been obtained by using simply solve (no need to use SolveTools:-PolynomialSystem).
You will see at the end of the file that the zeroes of the numerators are also those of the denominators.

141123_Problem_NoCorrelation_mmcdara.mw

Right, use entries and indices...

Answered: mmcdara 5603

November 14 2023

0 7

T := table([1=1, 2=4, 3=9]):
max(indices(T));
                               3
max(entries(T));
                               9

Note that for more complex forms of the indices the above can give unexpected results

T := table([[1, 3]=4, [3, 2]=5])

max(indices(T))
                               3

# You can use sort to find the largest index corresponding to a given order
ind := indices(T, nolist);
                         [1, 3], [3, 2]
max_index = sort([ind], key=(x -> x[2]))[-1]
                        max_index = [3, 2]

@Carl Love pointed out the incompleteness ogf my reply,
here is a way to get the index of the maximal entrie

T := table([ 1=23, 2=36, 3=14 ]);:
max_index = sort([entries(T)], output=permutation)[-1]
                         max_index = 2

@Carl Love : using the 'pairs' option seems to do lead to something more complex. Maybe this can be made simpler?

max_index = lhs(sort([indices(T,'pairs')], key=(x -> rhs(x)))[-1]);
                         max_index = 2

I don't see here any advantage in using 'pairs' instead of op(op(T)).

max_index = lhs(sort(op(op(T)), key=(x -> rhs(x)))[-1]);
                         max_index = 2

Analysis and reduction of your problem...

Answered: mmcdara 5603

November 13 2023

0 0

Your set of equations can be rewritting under the form of a system with 3 equations and 3 unknowns f, q3 and q5.
Details are here

>

with(PDEtools):

>

$OdeSys := {diff(f(xi, eta), eta)-q1(xi, eta) = 0, diff(q1(xi, eta), eta)-q2(xi, eta) = 0, diff(q3(xi, eta), eta)-q4(xi, eta) = 0, diff(q5(xi, eta), eta)-q6(xi, eta) = 0, f(xi, eta)*q6(xi, eta)+(diff(q6(xi, eta), eta)+Nt*(diff(q4(xi, eta), eta))/Nb)/Sc-Kr*q5(xi, eta)-xi*(q1(xi, eta)*(diff(q5(xi, eta), xi))-q6(xi, eta)*(diff(f(xi, eta), xi))) = 0, q2(xi, eta)*f(xi, eta)-xi*(q1(xi, eta)*(diff(q1(xi, eta), xi))-q2(xi, eta)*(diff(f(xi, eta), xi)))-q1(xi, eta)^2+sin(xi)*cos(xi)/xi+(diff(q2(xi, eta), eta))*(1+deltaA)-(deltaA*deltaB*xi*xi)*q2(xi, eta)^2*(diff(q2(xi, eta), eta))-Ma*(q1(xi, eta)-sin(xi)/xi)+Lam*sin(xi)*(q3(xi, eta)+Nm*q3(xi, eta)*q3(xi, eta)-Nr*q5(xi, eta))/xi = 0, (1+4*Rd*(1/3))*(diff(q4(xi, eta), eta))/Pr+Nb*q4(xi, eta)*q6(xi, eta)+f(xi, eta)*q4(xi, eta)+(Ma*Ec*xi*xi)*(q1(xi, eta)-sin(xi)/xi)^2+Nt*q4(xi, eta)^2+((1+deltaA)*Ec*xi*xi)*q2(xi, eta)^2-(1/3)*Ec*deltaA*deltaB*xi^4*q2(xi, eta)^4-xi*(q1(xi, eta)*(diff(q3(xi, eta), xi))-q4(xi, eta)*(diff(f(xi, eta), xi))) = 0}:$

>	numelems(OdeSys)

(1)

>	# Subsystem made of equations 1 to 4 SubSystem_1 := OdeSys[1..4]:

>

# Rewrite SubSystem_1 as a list of rewritting rules

SubSystem_1bis := map(eq -> -op(2, lhs(eq)) = op(1, lhs(eq)), SubSystem_1):

print();
RewrittingRules := [
                     SubSystem_1bis[1],
                     eval(SubSystem_1bis[2], SubSystem_1bis[1]),
                     SubSystem_1bis[3..4][]
                   ]:
print~(%):

q2(xi, eta) = diff(diff(f(xi, eta), eta), eta)

(2)

>	# The remaining subsystem SubSystem_2 := OdeSys[5..7]:

>	# The unknowns SubSystem_2 contains udu := select(has, indets(SubSystem_2, function), eta): du := map2(op, 1, select(has, udu, diff)): u := remove(has, udu, diff): Unknowns_2 := du union u

(3)

>	# Rewrite SubSystem_2 according to RewrittingRules SubSystem_2bis := eval(SubSystem_2, RewrittingRules):

>	# The unknowns SubSystem_2bis contains udu := select(has, indets(SubSystem_2bis, function), eta); S, Unknowns_2bis := selectremove(has, udu, diff): while S <> {} do S, R := selectremove(has, map2(op, 1, S), diff); Unknowns_2bis := Unknowns_2bis union R end do: Unknowns_2bis;

{diff(diff(diff(f(xi, eta), eta), eta), eta), diff(diff(f(xi, eta), eta), eta), diff(diff(f(xi, eta), eta), xi), diff(diff(q3(xi, eta), eta), eta), diff(diff(q5(xi, eta), eta), eta), diff(f(xi, eta), eta), diff(f(xi, eta), xi), diff(q3(xi, eta), eta), diff(q3(xi, eta), xi), diff(q5(xi, eta), eta), diff(q5(xi, eta), xi), f(xi, eta), q3(xi, eta), q5(xi, eta)}

(4)

>	# The remaining subsystem has 3 equations in 3 unknowns Unknowns_2bis # # Here are the derivatives it contains this should guide you to define # a suitable set of boundary conditions [select(has, udu, diff)[]]: print~([ seq(select(has, %, u)[], u in Unknowns_2bis) ]):

diff(diff(diff(f(xi, eta), eta), eta), eta)

diff(diff(f(xi, eta), eta), eta)

diff(diff(q3(xi, eta), eta), eta)

diff(diff(q5(xi, eta), eta), eta)

(5)

>	# Provided a solution of SubSystem_2bis augmented with ad hoc BCs has been obtained, # the expressions of the remaining unknowns RemainingUnknowns := remove(has, select(has, indets(OdeSys, function), eta), diff) minus Unknowns_2bis; # Can be buid from the RewrittingRules print~(RewrittingRules):

q2(xi, eta) = diff(diff(f(xi, eta), eta), eta)

(6)

>

Download Rewritten_system_mmcdara.mw

From the expresison of the Peng-Rob...

Answered: mmcdara 5603

November 10 2023

2 0

From the expresison of the Peng-Robinson EOS given here wiki here is a step-by-step procedure to find the result.
It mimics what you would do by hand, for what it worth...

Note that @dharr already gave you a faster way to get the desired result.

>

restart

Peng-Robinson_eos

>	eos := P = RT/(v-b)-aalpha/(v(v+b)+b(v-b))

(1)

>	relation_6 := A = aP/R^2/T^2; relation_7 := B = bP/R/T; relation_8 := Z = Pv/(RT);

(2)

>	eos_1 := eval(eos, isolate(relation_6, a));

(3)

>	eos_2 := eval(eos_1, isolate(relation_7, b));

P = R*T/(v-B*R*T/P)-A*R^2*T^2*alpha/(P*(v*(v+B*R*T/P)+B*R*T*(v-B*R*T/P)/P))

(4)

>	eos_3 := eval(eos_2, isolate(relation_8, P));

Z*R*T/v = R*T/(v-B*v/Z)-A*v*R*T*alpha/(Z*(v*(v+B*v/Z)+B*v*(v-B*v/Z)/Z))

(5)

>	eos_4 := numer(lhs(eos_3))denom(rhs(eos_3)) - numer(rhs(eos_3))denom(lhs(eos_3)) = 0

(6)

>	eos_5 := collect(eos_4, Z)

R*T*v^2*Z^5+(B*R*T*v^2-R*T*v^2)*Z^4+(-3*R*T*v^2*B^2-R*T*v^2*(-A*alpha+2*B))*Z^3+(R*T*v^2*B^3-R*T*v^2*(A*B*alpha-B^2))*Z^2 = 0

(7)

>	eos_6 := factor(eos_5)

(8)

>	# assuming Z^2RT*v^2 <> 0: eos_7 := collect(op(-1, lhs(eos_6)), Z) = 0

(9)

>

Download EOS.mw

E-Mail Address:
Password:
Remember Me:	Automatically sign in on future visits

E-Mail Address:
Password:
Remember Me:	Automatically sign in on future visits

Ask a Question

Create a Post

5603 Reputation

17 Badges

MaplePrimes Activity

These are answers submitted by mmcdara

I believe this can be done more simply...

One way...

Check your indices...

Non convergent Taylor expansion in the r...

Generally speaking things are done in th...

I've been stuck several hours until ...

Analysis...

First: convert solution into hyperbolic ...

Some results...

Alternative...

solve and plots:-inequal...

Boring that you change the answer that d...

Right, use entries and indices...

Analysis and reduction of your problem...

From the expresison of the Peng-Rob...

Save this setting as your default sorting preference?

Ask a Question

Create a Post

Generating PDF…

Save this setting as your default sorting preference?
Note: You can change your preference any time in your account settings
Don't show this again