acer

32333 Reputation

29 Badges

19 years, 323 days
Ontario, Canada

Social Networks and Content at Maplesoft.com

MaplePrimes Activity


These are answers submitted by acer

Note that "1/4 k" in Mathematica translates to "1/4*k" in Maple, but you have it wrongly as "1/(4*k)" in Maple. You made a similar mistake in at least two other places.

restart:
epsilon := 0.2:
h := z->1+epsilon*sin(2*Pi*z):
m := 10: k := 0.8:
A := (-m^2/4)-(1/4*k):
S1 := z->(h(z)^2)/4*A-ln(A*h(z)^2+1)*(1+h(z)^2)/4*A:

S1(0.9);

         27.86472748 + 35.20420042 I

Perhaps it's the case that your s or t (or both) can be taken to be real-valued.

restart;

kernelopts(version);

`Maple 2019.1, X86 64 LINUX, May 21 2019, Build ID 1399874`

with(LinearAlgebra):

N26 := Vector[row]([ 2*s^2*cos(t), 2*s^2*sin(t), s ]);

Vector[row](3, {(1) = 2*s^2*cos(t), (2) = 2*s^2*sin(t), (3) = s})

combine(Norm(N26, 2)) assuming t::real;

(4*abs(s)^4+abs(s)^2)^(1/2)

simplify(Norm(N26, 2)) assuming t::real;

abs(s)*(4*abs(s)^2+1)^(1/2)

combine(Norm(N26, 2)) assuming real;

(4*s^4+s^2)^(1/2)

simplify(Norm(N26, 2)) assuming real;

(4*s^2+1)^(1/2)*abs(s)

 

Download simp_real.mw

See also simplify(Norm(N26, 2, conjugate=false)) 

restart;

kernelopts(version);

  Maple 2019.1, X86 64 LINUX, May 21 2019, Build ID 1399874

f:=ln(s + 2)^2 + 2*polylog(2, -1 - s) + 2*polylog(2, (1 + s)/(s + 2)):

simplify(convert(f,dilog));

                      0
Related examples have been reported previously.
restart;

kernelopts(version);

   Maple 2019.1, X86 64 LINUX, May 21 2019, Build ID 1399874

u := < -(1/4)*a, -(1/12)*sqrt(3)*a, -x >:
v := < -(1/2)*a, (1/6)*sqrt(3)*a, (1/2)*x >:
Auv := Student:-MultivariateCalculus:-Angle(u, v):

solve({Auv = arccos(2*sqrt(26)*(1/13)), x>0, a>0}, x) assuming a>0;

                       /    1    (1/2)  \ 
                      { x = - 114      a }
                       \    6           / 
The inequality a>0 passed to `solve` may not actually be used of necessary. And the assumption on `a` may just serve to simplify the piecewise parametric result from `solve`. It's sad that `solve'` functionality is so disjointed (and no longer properly documented).

Are you supposing that tau and sigma1 are real?

restart;

SS1 := -4*sqrt(sigma1^2+4*tau^2)*tau^2/((sigma1+sqrt(sigma1^2
       +4*tau^2))^2*(1+4*abs(tau/(sigma1+sqrt(sigma1^2+4*tau^2)))^2));

-4*(sigma1^2+4*tau^2)^(1/2)*tau^2/((sigma1+(sigma1^2+4*tau^2)^(1/2))^2*(1+4*abs(tau/(sigma1+(sigma1^2+4*tau^2)^(1/2)))^2))

SS2 := 4*sqrt(sigma1^2+4*tau^2)*tau^2/((-sigma1+sqrt(sigma1^2
       +4*tau^2))^2*(1+4*abs(tau/(-sigma1+sqrt(sigma1^2+4*tau^2)))^2));

4*(sigma1^2+4*tau^2)^(1/2)*tau^2/((-sigma1+(sigma1^2+4*tau^2)^(1/2))^2*(1+4*abs(tau/(-sigma1+(sigma1^2+4*tau^2)^(1/2)))^2))

K1:=simplify(SS1) assuming real;

-2*tau^2*(sigma1^2+4*tau^2)^(1/2)/(sigma1*(sigma1^2+4*tau^2)^(1/2)+sigma1^2+4*tau^2)

K2:=simplify(SS2) assuming real;

2*tau^2*(sigma1^2+4*tau^2)^(1/2)/(sigma1^2-sigma1*(sigma1^2+4*tau^2)^(1/2)+4*tau^2)

Q:=[solve({S1=K1,S2=K2},{tau,sigma1},explicit)];

[{sigma1 = S1+S2, tau = (-S1*S2)^(1/2)}, {sigma1 = S1+S2, tau = -(-S1*S2)^(1/2)}]

diff(sigma1(S1,S2),S1)=diff(eval(sigma1,Q[1]),S1);
diff(sigma1(S1,S2),S2)=diff(eval(sigma1,Q[1]),S2);

diff(sigma1(S1, S2), S1) = 1

diff(sigma1(S1, S2), S2) = 1

diff(tau(S1,S2),S1)=diff(eval(tau,Q[1]),S1);
diff(tau(S1,S2),S2)=diff(eval(tau,Q[1]),S2);

diff(tau(S1, S2), S1) = -(1/2)*S2/(-S1*S2)^(1/2)

diff(tau(S1, S2), S2) = -(1/2)*S1/(-S1*S2)^(1/2)

diff(tau(S1,S2),S1)=diff(eval(tau,Q[2]),S1);
diff(tau(S1,S2),S2)=diff(eval(tau,Q[2]),S2);

diff(tau(S1, S2), S1) = (1/2)*S2/(-S1*S2)^(1/2)

diff(tau(S1, S2), S2) = (1/2)*S1/(-S1*S2)^(1/2)

factor(simplify(SS1+SS2)) assuming real;

sigma1

factor(simplify(SS1*SS2)) assuming real;

-tau^2

 

Download solve_thing.mw

restart;

L1 := [[1,2,3],[7,8,9],[13,12,11]]:

map[2](op,3,L1);
                           [3, 9, 11]

map(`?[]`,L1,[3]);
                           [3, 9, 11]

L2 := [1, [2, 3], [4, [5, 6], 7], [8, 3], 9]:

map[2](op,1,L2);
                        [1, 2, 4, 8, 9]

map(u->`if`(u::list,u[1],u),L2);
                        [1, 2, 4, 8, 9]

L3 := [[1,2,3],[7,8,2],[13,12,1]]:

sort(L3, (a,b) -> a[3]<b[3]);
              [[13, 12, 1], [7, 8, 2], [1, 2, 3]]

If your list contains a mix of list and scalars (like L2 above) then don't use that op approach if the entries are not all lists or integers. And you may also want to allow for empty sublists. For example,

L4 := [1,[2,3],11.02,[],[4,[5,6],7],[8,3],9.0003,[]]:

map(u->`if`(u::list,`if`(nops(u)>0,u[1],NULL),u), L4);
          [1, 2, 11.02, 4, 8, 9.0003]

restart

with(plots):

with(CurveFitting):

Digits := 50:

Direct := diff(C(x, t), t) = -.5*(diff(C(x, t), x))+10*(diff(C(x, t), x, x)):

g := proc (t) options operator, arrow; piecewise(0 < t and t <= 2000, 0, 2000 < t and t <= 4000, 0.5e-2*t-10, 4000 < t and t <= 6000, (-1)*0.25e-2*t+20, 6000 < t and t <= 9000, 0.5e-2*t-25, 9000 < t and t <= 16000, (-1)*0.286e-2*t+45.76, 16000 < t and t <= 20000, 0) end proc:

plot(g(t), t = 0 .. 20000):

``

IBCD := C(x, 0) = 0, C(0, t) = g(t), (D[1](C))(10000, t) = 0:

pdsD := pdsolve(Direct, [IBCD], time = t, range = 0 .. 10000, timestep = 60, numeric, spacestep = 25)

module () local INFO; export plot, plot3d, animate, value, settings; option `Copyright (c) 2001 by Waterloo Maple Inc. All rights reserved.`; end module

NULL

NULL

pts := [Vector[row](100, {(1) = 0, (2) = 101.010101, (3) = 202.020202, (4) = 303.030303, (5) = 404.040404, (6) = 505.0505051, (7) = 606.0606061, (8) = 707.0707071, (9) = 808.0808081, (10) = 909.0909091, (11) = 1010.10101, (12) = 1111.111111, (13) = 1212.121212, (14) = 1313.131313, (15) = 1414.141414, (16) = 1515.151515, (17) = 1616.161616, (18) = 1717.171717, (19) = 1818.181818, (20) = 1919.191919, (21) = 2020.20202, (22) = 2121.212121, (23) = 2222.222222, (24) = 2323.232323, (25) = 2424.242424, (26) = 2525.252525, (27) = 2626.262626, (28) = 2727.272727, (29) = 2828.282828, (30) = 2929.292929, (31) = 3030.30303, (32) = 3131.313131, (33) = 3232.323232, (34) = 3333.333333, (35) = 3434.343434, (36) = 3535.353535, (37) = 3636.363636, (38) = 3737.373737, (39) = 3838.383838, (40) = 3939.393939, (41) = 4040.40404, (42) = 4141.414141, (43) = 4242.424242, (44) = 4343.434343, (45) = 4444.444444, (46) = 4545.454545, (47) = 4646.464646, (48) = 4747.474747, (49) = 4848.484848, (50) = 4949.494949, (51) = 5050.505051, (52) = 5151.515152, (53) = 5252.525253, (54) = 5353.535354, (55) = 5454.545455, (56) = 5555.555556, (57) = 5656.565657, (58) = 5757.575758, (59) = 5858.585859, (60) = 5959.59596, (61) = 6060.606061, (62) = 6161.616162, (63) = 6262.626263, (64) = 6363.636364, (65) = 6464.646465, (66) = 6565.656566, (67) = 6666.666667, (68) = 6767.676768, (69) = 6868.686869, (70) = 6969.69697, (71) = 7070.707071, (72) = 7171.717172, (73) = 7272.727273, (74) = 7373.737374, (75) = 7474.747475, (76) = 7575.757576, (77) = 7676.767677, (78) = 7777.777778, (79) = 7878.787879, (80) = 7979.79798, (81) = 8080.808081, (82) = 8181.818182, (83) = 8282.828283, (84) = 8383.838384, (85) = 8484.848485, (86) = 8585.858586, (87) = 8686.868687, (88) = 8787.878788, (89) = 8888.888889, (90) = 8989.89899, (91) = 9090.909091, (92) = 9191.919192, (93) = 9292.929293, (94) = 9393.939394, (95) = 9494.949495, (96) = 9595.959596, (97) = 9696.969697, (98) = 9797.979798, (99) = 9898.989899, (100) = 10000}), Vector[row](100, {(1) = 0., (2) = 0., (3) = 0., (4) = 0., (5) = 0., (6) = 0., (7) = 0.2e-4, (8) = 0.10e-3, (9) = 0.56e-3, (10) = 0.248e-2, (11) = 0.919e-2, (12) = 0.2857e-1, (13) = 0.7551e-1, (14) = .17180, (15) = .34128, (16) = .60125, (17) = .95511, (18) = 1.39139, (19) = 1.88934, (20) = 2.42694, (21) = 2.98667, (22) = 3.55718, (23) = 4.13232, (24) = 4.70924, (25) = 5.28676, (26) = 5.86447, (27) = 6.44223, (28) = 7.02000, (29) = 7.59778, (30) = 8.17555, (31) = 8.75333, (32) = 9.33110, (33) = 9.90886, (34) = 10.48658, (35) = 11.06420, (36) = 11.64158, (37) = 12.21841, (38) = 12.79408, (39) = 13.36737, (40) = 13.93611, (41) = 14.49665, (42) = 15.04318, (43) = 15.56715, (44) = 16.05673, (45) = 16.49676, (46) = 16.86924, (47) = 17.15449, (48) = 17.33308, (49) = 17.38802, (50) = 17.30713, (51) = 17.08478, (52) = 16.72287, (53) = 16.23085, (54) = 15.62469, (55) = 14.92534, (56) = 14.15692, (57) = 13.34508, (58) = 12.51563, (59) = 11.69367, (60) = 10.90282, (61) = 10.16470, (62) = 9.49811, (63) = 8.91819, (64) = 8.43537, (65) = 8.05441, (66) = 7.77367, (67) = 7.58484, (68) = 7.47331, (69) = 7.41912, (70) = 7.39856, (71) = 7.38612, (72) = 7.35668, (73) = 7.28756, (74) = 7.16043, (75) = 6.96260, (76) = 6.68785, (77) = 6.33655, (78) = 5.91524, (79) = 5.43562, (80) = 4.91320, (81) = 4.36573, (82) = 3.81158, (83) = 3.26826, (84) = 2.75118, (85) = 2.27275, (86) = 1.84190, (87) = 1.46393, (88) = 1.14072, (89) = .87118, (90) = .65192, (91) = .47788, (92) = .34306, (93) = .24113, (94) = .16592, (95) = .11174, (96) = 0.7364e-1, (97) = 0.4749e-1, (98) = 0.2996e-1, (99) = 0.1850e-1, (100) = 0.1244e-1})]

A := unapply(Spline(pts[1], pts[2], x, degree = 2), x):

plot(A(x), x = 0 .. 10000):

Inverse := diff(C(x, t), t) = .5*(diff(C(x, t), x))-50000*(diff(C(x, t), x, x, x, x))-10*(diff(C(x, t), x, x)):

NULL

NULL

IBCI := C(x, 0) = A(x), (D[1](C))(0, t) = 0, (D[1](C))(10000, t) = 0, (D[1, 1](C))(0, t) = 0, (D[1, 1](C))(10000, t) = 0:

pdsI := pdsolve(Inverse, [IBCI], time = t, range = 0 .. 10000, timestep = .5, numeric, spacestep = 25)

module () local INFO; export plot, plot3d, animate, value, settings; option `Copyright (c) 2001 by Waterloo Maple Inc. All rights reserved.`; end module

A1 := pdsI:-animate(t = 20000, frames = 20, title = "time = %f"):

A1;

A2 := pdsD:-animate(t = 20000, frames = 20, title = "time = %f"):

A2;

h := display(A1, A2):

h;

 

Download both_of_them_ac.mw

@ajfriedlan You could have a look at the Grid package (and perhaps Grid:-Map in particular, to map your integrating process across a list/Array of parameter values). The big difference being that the Grid package parallelizes by launching new and separate kernel engines to do the work -- thus potentially alleviating the need for thread-safety.

As for ArrayTools:-Concatenate, I am not sure about that particular procedure but I notice that it calls ArrayTools:-Copy. Now, ArrayTools:-Copy does an interesting thing: the first time it gets called (per restart) it replaces itself with a call to a compiled external function. But that replacement operation is not thread-safe, and if one thread tries to call the command while another is in the process of making its first call then bad things could happen. So one simplistic way to try and deal with this is to execute a (typical, for your code) preliminary, dummy call to ArrayTools:-Concatenate and/or ArrayTools:-Copy before you try can run your code under the Threads package. But if you manage to replace all your Threads attempts with Grid attempts then this all may be moot to you.

 

 

Here's an alternative, which keeps construction of A1 and A2 separate (if that's what you prefer).

The key thing is that the legend becomes a so-called local property of the curve plotting structure (technically, a substructure of the CURVES plotting structure).

That's the case in each frame, with the code below. The plot command knows how to do that. But when you originally called plots:-display([A1,A2],legend=[...],...) then the plots:-display command did not know how to dig into the A1 and A2 animations and find which curves to associate with the supplied legend items.

Sure, that is a weakness of plots:-display (but there are much harder situations in similar examples, and it would be inconsistent to only handle a smattering of cases). 

c := x -> piecewise(0 <= x and x <= 450000, 0.37*x, 450000 < x,
                    0.37*x + 0.06*(x - 450000)):
g := x -> piecewise(0 <= x and x <= 558000, 0.37*x, 558000 < x,
                    0.37*x + 0.12*(x - 558000)):

A1 := plots:-animate(plot, [g(x), x = 0 .. skat, color = blue, legend="Line 1"],
                     frames = 20, skat = 0 .. 1000000):
A2 := plots:-animate(plot, [c(x), x = 0 .. skat, color = red, legend="Line 2"],
                     frames = 20, skat = 0 .. 1000000):

plots:-display([A1, A2], size = [500, 350], gridlines = true,
               legendstyle=[font=[Lucida, roman, 14], location=bottom]);

Using evalf[4] is a bad idea. The prevents Maple from using an adequate amount of working precision. If you only need 4 digits of accuracy then better would be to utilize the epsilon=10.0^(-4) option of evalf(Int(...)) .

If you want to do purely numeric integration then call evalf(Int(...)) where capitalised Int is inert. Your worksheet was trying to do symbolic integration first (and consuming large resources until it failed, partly because symbolic integration in the presence of float coefficients is not a good idea). 

The following are all done (in Maple 18, just as you tried it) very quickly.

restart

`&lambda;1_B`[so] := 10.94:

NULL

W[1] := evalf(Int(`&alpha;_B`[so]^2/((z-1+`&alpha;_B`[so])^2*(z^(`&lambda;2_B`[so]/`&lambda;1_B`[so])-1+`&alpha;_B`[so])), z = 1 .. infinity));

.9534065377

0.4866131761e-2

0.1272340450e-2

0.1743379456e-1

0.6784880009e-3

0.3346927628e-2

0.5053345966e-3

0.1359458287e-3

0.1640449195e-3

0.5093746803e-4

0.7366478346e-4

NULL

NULL

Download ask_maple_ac.mw

m2 := map(rhs,m1);

It's not clear whether you expect all other variables (parameters) to be free, or subject to some conditions.

When you call solve(sys,{p,q}) you are asking for solutions without restrictions on the parameters. But perhaps that's not what you are after.

Compare with the result of calling simply  solve(sys);

If the condition C=0 holds then any p and q provide a solution.

There are other restricted cases. For example if R takes its values from a specific formula (in the remaining parameters) then there are infinitely many solutions where p=I*q or p=-I*q and q is anything. Notice that in some of the following omega__n cannot be zero.

restart;

Eq1:=61*q*L__1^2*C*e*eta/(16*omega__n^2)+5*q*L__1^2*C*e^3*eta^3/(8*omega__n^4)
+3*C*p^3*gamma__1*(1/4)+3*q*C*p^2*R__n/(4*omega__n)
+q*L__1^2*C*e^4*eta^4/(16*omega__n^5)+145*q*L__1^2*C/(64*omega__n)
+3*q^3*C*R__n/(4*omega__n)+3*p*C*q^2*gamma__1*(1/4)+q*R*C/(4*omega__n)
+19*q*L__1^2*C*e^2*eta^2/(8*omega__n^3);

(61/16)*q*L__1^2*C*e*eta/omega__n^2+(5/8)*q*L__1^2*C*e^3*eta^3/omega__n^4+(3/4)*C*p^3*gamma__1+(3/4)*q*C*p^2*R__n/omega__n+(1/16)*q*L__1^2*C*e^4*eta^4/omega__n^5+(145/64)*q*L__1^2*C/omega__n+(3/4)*q^3*C*R__n/omega__n+(3/4)*p*C*q^2*gamma__1+(1/4)*q*R*C/omega__n+(19/8)*q*L__1^2*C*e^2*eta^2/omega__n^3

Eq2:=-3*C*p^3*R__n/(4*omega__n)-3*p*C*q^2*R__n/(4*omega__n)
-p*L__1^2*C*e^4*eta^4/(16*omega__n^5)-5*p*L__1^2*C*e^3*eta^3/(8*omega__n^4)
-19*p*L__1^2*C*e^2*eta^2/(8*omega__n^3)-61*p*L__1^2*C*e*eta/(16*omega__n^2)
-145*p*L__1^2*C/(64*omega__n)-p*R*C/(4*omega__n)+3*q*C*p^2*gamma__1*(1/4)
+3*q^3*C*gamma__1*(1/4);

-(3/4)*C*p^3*R__n/omega__n-(3/4)*p*C*q^2*R__n/omega__n-(1/16)*p*L__1^2*C*e^4*eta^4/omega__n^5-(5/8)*p*L__1^2*C*e^3*eta^3/omega__n^4-(19/8)*p*L__1^2*C*e^2*eta^2/omega__n^3-(61/16)*p*L__1^2*C*e*eta/omega__n^2-(145/64)*p*L__1^2*C/omega__n-(1/4)*p*R*C/omega__n+(3/4)*q*C*p^2*gamma__1+(3/4)*q^3*C*gamma__1

sys := {Eq1, Eq2}:

solve(sys, {p,q});

{p = 0, q = 0}

solve(sys);

{C = 0, L__1 = L__1, R = R, R__n = R__n, e = e, eta = eta, p = p, q = q, gamma__1 = gamma__1, omega__n = omega__n}, {C = C, L__1 = L__1, R = -(1/16)*(4*L__1^2*e^4*eta^4+40*L__1^2*e^3*eta^3*omega__n+152*L__1^2*e^2*eta^2*omega__n^2+244*L__1^2*e*eta*omega__n^3+48*R__n*p^2*omega__n^4+48*R__n*q^2*omega__n^4+145*L__1^2*omega__n^4)/omega__n^4, R__n = R__n, e = e, eta = eta, p = p, q = q, gamma__1 = 0, omega__n = omega__n}, {C = C, L__1 = L__1, R = R, R__n = R__n, e = e, eta = eta, p = 0, q = 0, gamma__1 = gamma__1, omega__n = omega__n}, {C = C, L__1 = L__1, R = -(1/16)*L__1^2*(4*e^4*eta^4+40*e^3*eta^3*omega__n+152*e^2*eta^2*omega__n^2+244*e*eta*omega__n^3+145*omega__n^4)/omega__n^4, R__n = R__n, e = e, eta = eta, p = RootOf(_Z^2+1)*q, q = q, gamma__1 = gamma__1, omega__n = omega__n}

solve(eval(sys,C=0), {p,q});

{p = p, q = q}

solve(eval(sys,gamma__1=0), {p,q}, explicit);

{p = (1/12)*(-3*R__n*(4*L__1^2*e^4*eta^4+40*L__1^2*e^3*eta^3*omega__n+152*L__1^2*e^2*eta^2*omega__n^2+244*L__1^2*e*eta*omega__n^3+48*R__n*q^2*omega__n^4+145*L__1^2*omega__n^4+16*R*omega__n^4))^(1/2)/(R__n*omega__n^2), q = q}, {p = -(1/12)*(-3*R__n*(4*L__1^2*e^4*eta^4+40*L__1^2*e^3*eta^3*omega__n+152*L__1^2*e^2*eta^2*omega__n^2+244*L__1^2*e*eta*omega__n^3+48*R__n*q^2*omega__n^4+145*L__1^2*omega__n^4+16*R*omega__n^4))^(1/2)/(R__n*omega__n^2), q = q}, {p = 0, q = 0}, {p = 0, q = (1/12)*(-3*R__n*(4*L__1^2*e^4*eta^4+40*L__1^2*e^3*eta^3*omega__n+152*L__1^2*e^2*eta^2*omega__n^2+244*L__1^2*e*eta*omega__n^3+145*L__1^2*omega__n^4+16*R*omega__n^4))^(1/2)/(R__n*omega__n^2)}, {p = 0, q = -(1/12)*(-3*R__n*(4*L__1^2*e^4*eta^4+40*L__1^2*e^3*eta^3*omega__n+152*L__1^2*e^2*eta^2*omega__n^2+244*L__1^2*e*eta*omega__n^3+145*L__1^2*omega__n^4+16*R*omega__n^4))^(1/2)/(R__n*omega__n^2)}

solve(sys,{p,q,R},explicit);

{R = R, p = 0, q = 0}, {R = -(1/16)*L__1^2*(4*e^4*eta^4+40*e^3*eta^3*omega__n+152*e^2*eta^2*omega__n^2+244*e*eta*omega__n^3+145*omega__n^4)/omega__n^4, p = I*q, q = q}, {R = -(1/16)*L__1^2*(4*e^4*eta^4+40*e^3*eta^3*omega__n+152*e^2*eta^2*omega__n^2+244*e*eta*omega__n^3+145*omega__n^4)/omega__n^4, p = -I*q, q = q}

solve(sys,{p,q},parametric); # wide output

 

Download solveparametric.mw

I have edited my response so that it works in Maple 18.02, 2015.2, 2016.2, 2017.2, 2018.2 and 2019.1, etc (and so that it doesn't rely on the so-called "hover-over" contour labelling functionality introduced in Maple 2017).

I also added support for filledregions, and it works similarly to plots:-contourplot in the sense that it uses solid colors for the regions. This is in contrast to plots:-densityplot which fills the regions with color gradations. (See the last example for the distinction.)

It properly supports only the "zgradient" scheme. And it only supports the expression form calling sequence of plots:-contourplot.

But the main point is that it allows for schemes other than just the original request. (Ie. not just mimicing part of a rainbow.)

restart;

kernelopts(version);

`Maple 18.02, X86 64 LINUX, Oct 20 2014, Build ID 991181`

CP:=proc({contours::list(numeric):=[]},
         {colorscheme::list:=NULL})
  local cP,CPraw,CVlist,CVnew,CVvals,pnP,PNlist,PNnew,PNvals,
        Carray,pCarray,CVPN,F,helper,i,j,other,T,pnT,u,vars,version;
  version:=parse((s->s[7..StringTools:-Search(",",s)-1])(convert(kernelopts(version),
                                                                 string)));
  vars := [seq(lhs(u),u=select(type,[_rest],name=range(realcons)))];
  F:=unapply(args[1],vars);
  if nops(contours)=0 then error "at least one contour is required"; end if;
  CPraw:=plots:-contourplot(_rest,':-contours'=contours,
                            ':-coloring'=["red","blue"]);
  CVPN,other:=selectremove(type,[op(CPraw)],'specfunc'(anything,{CURVES,POLYGONS}));
  CVlist,PNlist:=selectremove(type,CVPN,'specfunc'(anything,{CURVES}));
  CVlist:=subsindets(CVlist,'specfunc'(anything,{COLOR,COLOUR}),()->NULL);
  CVlist:=select(u->hastype(u,[numeric,numeric]),CVlist);
  PNlist:=subsindets(PNlist,'specfunc'(anything,{COLOR,COLOUR}),()->NULL);
  PNlist:=select(u->hastype(u,[numeric,numeric]),PNlist);
  # Separating all the polygons is possible, but it's not
  # worth it since densityplot is more efficient.
  ##PNlist:=map(pn->seq(POLYGONS(this,op(remove(type,[op(pn)],list))),
  ##                    this=select(type,[op(pn)],list)),PNlist);
  helper:=proc(c) local cc;
                    if nops(c)>0 then
                      add(F(op(cc)),cc=c)/nops(c);
                    else undefined; end if;
                  end proc;
  CVvals:=map(CV->helper([op(indets(CV,[numeric,numeric]))]),CVlist);
  if version < 2016 then
    cP:=plots:-pointplot3d([seq([i,1,CVvals[i]],i=1..nops(CVvals))],
                           ':-colorscheme'=colorscheme);
  else
    cP:=plot([seq([i,CVvals[i]],i=1..nops(CVvals))],
             ':-colorscheme'=colorscheme);
  end if;
  Carray:=op([2],indets(cP,{'specfunc'(anything,{COLOR,COLOUR})})[1]);
  if nops(ArrayTools:-Dimensions(Carray))=2 then
    T:=table([seq(CVvals[i]=[seq(Carray[i,j],j=1..3)],i=1..nops(CVvals))]);
  elif nops(ArrayTools:-Dimensions(Carray))=3 then
    T:=table([seq(CVvals[i]=[seq(Carray[i,1,j],j=1..3)],i=1..nops(CVvals))]);
  end if;
  CVnew:=seq(CURVES(op(CVlist[i]),`if`(CVvals[i]<>undefined,
                                       COLOUR(RGB,op(T[CVvals[i]])),
                                       NULL)),i=1..nops(CVlist));
  PNvals:=map(PN->helper([op(indets(PN,[numeric,numeric]))]),PNlist);
  if PNvals::list(numeric) and nops(PNvals)>0 then
    if version < 2016 then
      pnP:=plots:-pointplot3d([seq([i,1,PNvals[i]],i=1..nops(PNvals))],
                              ':-colorscheme'=colorscheme);
    else
      pnP:=plot([seq([i,PNvals[i]],i=1..nops(PNvals))],
                ':-colorscheme'=colorscheme);
    end if;
    pCarray:=op([2],indets(pnP,{'specfunc'(anything,{COLOR,COLOUR})})[1]);
    if nops(ArrayTools:-Dimensions(Carray))=2 then
      pnT:=table([seq(PNvals[i]=[seq(pCarray[i,j],j=1..3)],i=1..nops(PNvals))]);
    elif nops(ArrayTools:-Dimensions(pCarray))=3 then
      pnT:=table([seq(PNvals[i]=[seq(pCarray[i,1,j],j=1..3)],i=1..nops(PNvals))]);
    end if;
    PNnew:=seq(POLYGONS(op(PNlist[i]),COLOUR(RGB,op(pnT[PNvals[i]]))),i=1..nops(PNlist));
  else
    PNnew:=NULL;
  end if;
  PLOT(CVnew,PNnew,op(other));
end proc:

#
#
#

cont1:=[-0.99, seq(-0.9 .. -0.1, 0.1), seq(0.1 .. 0.9, 0.1), 0.99]:

scheme1:=["zgradient",["Blue", "Green", "Yellow", "Red"]];

["zgradient", ["Blue", "Green", "Yellow", "Red"]]

P1:=CP(sin(x*y), x = -2 .. 2, y = -2 .. 2,
       axes = framed, gridlines=false, grid=[101,101],
       contours = cont1,
       colorscheme=scheme1):
P1;

transformer:=plottools:-transform((x,y)->[x,y,-1]):

plots:-display(
  plot3d(sin(x*y), x = -2 .. 2, y = -2 .. 2,
         colorscheme = scheme1),
  subsindets(transformer(P1),
             'specfunc'(anything,_GRIDLINES),()->NULL)
);

#
# The procedure CP also handles filledregions.
#
P1filled:=CP(sin(x*y), x = -2 .. 2, y = -2 .. 2,
       axes = framed, gridlines=false, grid=[101,101],
       contours = cont1, filledregions,
       colorscheme=scheme1):
P1filled;

plots:-display(
  plot3d(sin(x*y), x = -2 .. 2, y = -2 .. 2,
         colorscheme = scheme1),
  subsindets(transformer(P1filled),
             'specfunc'(anything,_GRIDLINES),()->NULL)
);

P2:=CP(cos(s*t), s = -2 .. 2, t = -2 .. 2,
       axes = framed, gridlines=false, grid=[101,101],
       contours = cont1,
       colorscheme=["zgradient",["Blue", "Cyan", "Green", "Orange", "Yellow", "Red"]]):
P2;

cont2:=[seq(-1.0 .. -0.05, 0.05), seq(0.05 .. 1.0, 0.05)]:
scheme2:=["zgradient",["Green", "Purple", "Yellow", "Blue"]];

["zgradient", ["Green", "Purple", "Yellow", "Blue"]]

P3:=CP(sin(a)*b^2, a = -Pi+0.1 .. Pi-0.1, b = -1..1,
       axes = framed, gridlines=false,
       contours = cont2, colorscheme=scheme2):
P3;

transformer:=plottools:-transform((x,y)->[x,y,-1]):

plots:-display(
  plot3d(sin(a)*b^2, a = -Pi+0.1 .. Pi-0.1, b = -1..1,
         colorscheme = scheme2),
  subsindets(transformer(P3),
             'specfunc'(anything,_GRIDLINES),()->NULL)
);

P3filled:=CP(sin(x)*y^2, x = -Pi+0.1 .. Pi-0.1, y = -1..1,
       axes = framed, gridlines=false, filledregions,
       contours = cont2,
       colorscheme=scheme2):
P3filled;

plots:-display(
  plot3d(sin(x)*y^2, x = -Pi+0.1 .. Pi-0.1, y = -1..1,
         colorscheme = scheme2),
  subsindets(transformer(P3filled),
             'specfunc'(anything,_GRIDLINES),()->NULL)
);

# without the contour lines themselves
plots:-display(
  plot3d(sin(x)*y^2, x=-Pi+0.1..Pi-0.1, y=-1..1,
         colorscheme=scheme2),
  subsindets(transformer(P3filled),
             'specfunc'(anything,{CURVES,_GRIDLINES}),()->NULL)
);

P3dens:=plots:-densityplot(sin(x)*y^2,x=-Pi+0.1..Pi-0.1,y=-1..1,
                           style=surface,colorscheme=scheme2,axes=box):
P3dens;

plots:-display(
  plot3d(sin(x)*y^2, x=-Pi+0.1..Pi-0.1, y=-1..1,
         colorscheme=scheme2),
  transformer(P3dens)
);

 

contourplot_colorscheme_P_1802.zip

Here is my original answer, which requires the so-called "hover-over" contour labelling functionality introduced in Maple 2017.

Download contourplot_colorscheme.mw

You are trying to concatenate the strings (possibly including some white space, etc, to separate them).

How about something like these:

SetProperty(Label0, caption, sprintf("%s %s", textOne, textTwo) );

SetProperty(Label0, caption, sprintf("%s, %s", textOne, textTwo) );

Using Kitonum's procedure with Carl Love's improvements:

    https://mapleprimes.com/posts/202222-Contour-Curves-With-Labels

But also using plottools:-transform to get the plot of u versus x and t.

You may wish to adjust the choice of colors, or the choice of labelled contour values (assigned to conts1 in the code below) so as to get better placement.

restart;

# Kitonum's procedure with Carl Love's improvements.
#
# https://mapleprimes.com/posts/202222-Contour-Curves-With-Labels
#
ContoursWithLabels:= proc(
     Expr::algebraic,
     Range1::(name= range(realcons)), Range2::(name= range(realcons)),
     {contours::{posint, {set,list}(realcons)}:= 8},
     {ImplicitplotOptions::{list,set}({name, name= anything}):= NULL},
     {GraphicOptions::{list,set}({name, name= anything}):= NULL},
     {TextOptions::{list,set}({name, name= anything}):= NULL},
     {Coloring::{list,set}({name, name= anything}):= NULL}
)
local
     r1, r2, f, L1, h, S1, P, r, M, C, T, p, p1, m, n, i,
     x:= lhs(Range1), y:= lhs(Range2)
;
     f:= unapply(Expr, (x,y));
     if contours::posint then
          r1:= rand(convert(rhs(Range1), float));
          r2:= rand(convert(rhs(Range2), float));
          L1:= select(type, (f@op)~({seq([r1,r2](), i= 1..205)}), realcons);
          h:= (L1[-6]-L1[1])/contours;
          S1:= [seq(L1[1]+h/2+h*(n-1), n= 1..contours)]
     else #contours::{set,list}(realcons)
          S1:= [contours[]]
     end if;
     userinfo(1, ContoursWithLabels, print('Contours' = evalf[2](S1)), `\n`);
     r:= k-> rand(20..k-20);
     for C in S1 do
          P:= plots:-implicitplot(
               Expr = C, Range1, Range2,
               gridrefine= 3, ImplicitplotOptions[]
          );
          for p in [plottools:-getdata(P)] do
               p1:= convert(p[3], listlist);
               n:= nops(p1);
               if n < 500 then
                    m:= `if`(40 < n, r(n)(), round(n/2));
                    M[`if`(40 < n, [p1[1..m-11], p1[m+11..n]], [p1])[]]:= NULL;
                    T[[p1[m][], evalf[2](C)]]:= NULL
               else
                    h:= trunc(n/2);
                    m:= r(h)();
                    M[p1[1..m-11], p1[m+11..m+h-11], p1[m+h+11..n]]:= NULL;
                    T[[p1[m][], evalf[2](C)], [p1[m+h][], evalf[2](C)]]:= NULL
               end if
          end do
     end do;
     plots:-display(
          [`if`(
               Coloring = NULL,
               NULL,
               plots:-densityplot(Expr, Range1, Range2, Coloring[])
          ),
          plot([indices(M, 'nolist')], color= black, GraphicOptions[]),
          plots:-textplot([indices(T, 'nolist')], TextOptions[])
         ], 'axes'= 'box', 'gridlines'= false, _rest
     )
end proc:

#
#
#

u:=1-(8*(10.3968*t^2-5.8368*t*f-.229376*f^2-5.1984))/(4.56*t^2-2.56*t*f+.8192*f^2+2.28)^2:

x:=f+t-(8*(-2.28*t+.64*f))/(2.28+2*(-t+.64*f)^2+2.56*t^2):

#
#
#

conts1:=[0.1, 0.3, 0.5, 0.7, 0.9, 1.3, 2.0]:
Pft := ContoursWithLabels(
       u,f=-7..7, t=-7..7, contours= conts1,
       TextOptions=[font=[HELVETICA,BOLD,10], color=red],
       ImplicitplotOptions=[gridrefine=4],
       GraphicOptions=[thickness=0],
       labelfont=[TIMES,BOLDITALIC,16], axesfont=[HELVETICA,8]):

conts2:=[seq(0.0..1.0, 0.1), seq(2.0..6.0, 1.0)]:
plots:-display(
  plottools:-transform((a,b)->eval([x,t],[f=a,t=b]))(Pft),
  subsindets(plots:-contourplot([x,t,u], f=-7..7, t=-7..7, grid=[101,101],
                       coloring=["Orange","Blue"], contours=conts2,
                       thickness=0, filledregions),
              specfunc(CURVES),()->NULL),
  size=[800,400], labels=["x","t"]
);


Download contour_labels_transformed.mw

 

First 150 151 152 153 154 155 156 Last Page 152 of 336