6
$\begingroup$

Cross-posted in Wolfram Community.


Firstly, the MATLAB program is

t = 0;
A = 2;
c1 = 1;
c2 = 1;
c = 1/25;
omega = 2;

[xi,eta]=meshgrid(-5:0.1:5,-4:0.1:6);

P = ((2*sinh(xi+omega*t))./(3*cosh(xi+omega*t)))+((5*sinh(xi+omega*t))./(6*cosh(xi+omega*t)).^3)+0.9;
Q = -(sinh(eta))./(cosh(eta));
x = xi-2.5*tanh(xi+omega*t);
y = eta;

Px = -(sech(xi+omega*t)).^2;
Qy = -(sech(eta)).^2;

u = ((A-c1.*c2).*Px.*Qy)./(1+c1.*P+c2.*Q+c.*P.*Q).^2;
view([-45 70]);

surf(x,y,u);
xlabel('x','FontSize',26,'FontName','Times New Roman','FontAngle', 'italic')
ylabel('y','FontSize',26,'FontName','Times New Roman','FontAngle', 'italic')
zlabel('$u$','interpreter','latex','FontSize',24,'FontName','Times New Roman','FontAngle', 'italic')

and it comes

enter image description here

With the same equation, the MMA program is

ω = 2;
A = 2; Subscript[c, 1] = Subscript[c, 2] = 1; Subscript[c, 3] = 1/25;
px = -Sech[ξ + ω t]^2; p = (2 Sinh[ξ + ω t])/(
  3 Cosh[ξ + ω t]) + (5 Sinh[ξ + ω t])/(
  6 Cosh[ξ + ω t]^3) + 0.9;
qy = -Sech[η]^2; q = -(Sinh[η]/Cosh[η]);
func[ξ_, η_, 
   t_] = ((A - Subscript[c, 1] Subscript[c, 2]) px qy)/(1 + 
      Subscript[c, 1] p + Subscript[c, 2] q + Subscript[c, 3] p q)^2 //
     Rationalize // Simplify;
xyToXiEta[x_, y_, t_] := 
  NSolve[{x == ξ - 2.5 Tanh[ξ + 2 t], 
    y == η}, {ξ, η}, Reals];
With[{t = 0}, 
 ListPlot3D[
  Flatten[Table[{x, y, func[ξ, η, t]} /. 
     xyToXiEta[x, y, t], {x, -2, 2, 0.04}, {y, -1, 5, 0.04}], 2], 
  Axes -> True, PlotRange -> {All, All, {0, 2}}, 
  AxesLabel -> {x, y, z}, ColorFunction -> "TemperatureMap"]]

and it comes

enter image description here.

Thanks Gianluca Gorni for providing the MMA program.

It is obvious that the MATLAB picture forms like a bridge with empty space under it. However, the MMA picture is solid. I think it might be caused by ``NSolve" in MMA.

How can I improve the MMA program to make it like MATLAB's result?

$\endgroup$
4
  • 3
    $\begingroup$ Why not ParametricPlot3D? $\endgroup$
    – xzczd
    Jan 10 at 4:21
  • 1
    $\begingroup$ I cannot reproduce your Mathematica plot. from your code. Please verify that it is correct by copying your code to a fresh notebook and running it. $\endgroup$
    – bbgodfrey
    Jan 10 at 6:12
  • $\begingroup$ Thank you for your notification, the code has been corrected and edited. $\endgroup$
    – InFei
    Jan 10 at 6:32
  • $\begingroup$ ParametricPlot3D is an excellent choice. Cause that I am a rookie, it would be better if you could modify the programme. $\endgroup$
    – InFei
    Jan 10 at 6:35
13
$\begingroup$

As mentioned in the comment above, one should use ParametricPlot3D for the task:

t = 0;
A = 2;
c1 = 1;
c2 = 1;
c = 1/25;
omega = 2;
With[{sinh = Sinh, cosh = Cosh, tanh = Tanh, sech = Sech},
  P = ((2 sinh@(xi + omega t))/(3 cosh@(xi + omega t))) + ((5 sinh@(xi + 
           omega t))/(6 cosh@(xi + omega t))^3) + 0.9;
  Q = -(sinh@(eta))/(cosh@(eta));
  x = xi - 2.5 tanh@(xi + omega t);
  y = eta;
  
  Px = -(sech@(xi + omega t))^2;
  Qy = -(sech@(eta))^2;
  
  u = ((A - c1 c2) Px Qy)/(1 + c1 P + c2 Q + c P Q)^2];

ParametricPlot3D[{x, y, u}, {xi, -5, 5}, {eta, -4, 6}, BoxRatios -> {1, 1, 0.4}, 
 PlotRange -> All, ColorFunction -> "BlueGreenYellow", PlotPoints -> 50]

Mathematica graphics

$\endgroup$
2
7
$\begingroup$

For completion I also post here my Wolfram Community answer. A direct translation of the code is not possible as that function does not exist (ListParametricPlot3D or so). But we can recreate the graphic "manually" by recreating the polygons, or rewrite the code to use ParametricPlot3D (preferred and nicer), I included both:

t = 0;
A = 2;
c1 = 1;
c2 = 1;
c = 1/25;
omega = 2;

pts = Array[List/*N, 101 {1, 1}, {{-5, 5}, {-4, 6}}];
{xi, eta} = {pts[[All, All, 1]], pts[[All, All, 2]]};

P = 2 Sinh[xi + omega t]/(3 Cosh[xi + omega t]) + (5 Sinh[xi + omega t]/(6 Cosh[xi + omega t])^3) + 0.9;
Q = -Sinh[eta]/Cosh[eta];
x = xi - 2.5 Tanh[xi + omega t];
y = eta;

Px = -Sech[xi + omega t]^2;
Qy = -Sech[eta]^2;

u = (A - c1 c2) Px Qy/(1 + c1 P + c2 Q + c P Q)^2;

pols = BlockMap[{{#[[1, 1]], #[[1, 2]], #[[2, 1]]}, {#[[2, 1]], #[[1, 
   2]], #[[2, 2]]}} &, Transpose[{x, y, u}, {3, 1, 2}], {2, 2}, {1, 1}];
pols = Catenate[Catenate[pols]];
Graphics3D[Polygon[pols], BoxRatios -> {1, 1, 1}]

enter image description here

ClearAll[funcu]
funcu[xi_, eta_] := Module[{t = 0, A = 2, c1 = 1, c2 = 1, c = 1/25, omega = 2, P, Q, x, y, Px, Qy},
  P = 2 Sinh[xi + omega t]/(3 Cosh[xi + omega t]) + (5 Sinh[xi + omega t]/(6 Cosh[xi + omega t])^3) + 0.9;
  Q = -Sinh[eta]/Cosh[eta];
  x = xi - 2.5 Tanh[xi + omega t];
  y = eta;
  Px = -Sech[xi + omega t]^2;
  Qy = -Sech[eta]^2;
  {x, y, (A - c1 c2) Px Qy/(1 + c1 P + c2 Q + c P Q)^2}
]
ParametricPlot3D[funcu[xi, eta], {xi, -5, 5}, {eta, -4, 6}, BoxRatios -> {1, 1, 1}, PlotRange -> All, PlotPoints -> 80, ColorFunction -> Function[{x, y, z, \[Phi], \[Theta]}, ColorData["BlueGreenYellow"][z]]]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.