How can I make a plot similar to the one below (enthalpy vs T plot) in Mathematica?
Thank you very much in advance
$\begingroup$
$\endgroup$
5
-
$\begingroup$ Do you have expressions for those curves? $\endgroup$– MarcoBCommented Nov 18, 2020 at 4:28
-
$\begingroup$ @MarcoB No, I don't. The curves are just schematics. So, anything that resembles that should work. The only thing to notice is that the curves are linear in the glass and liquid regions, as you can see by the dotted lines and there is only a region in between which is not linear. I am not sure how to do that part in Mathematica to resemble that figure. $\endgroup$– JohnCommented Nov 18, 2020 at 4:35
-
$\begingroup$ What have you tried? Which part are you having difficulty? $\endgroup$– xzczd ♦Commented Nov 18, 2020 at 4:48
-
$\begingroup$ @xzczd I can do exactly the same plot but completely linear (without the non linear region). I am not sure how to reproduce that region in mathematica. $\endgroup$– JohnCommented Nov 18, 2020 at 4:52
-
$\begingroup$ Do you mean you don't know how to link 2 straight lines with a smooth curve? $\endgroup$– xzczd ♦Commented Nov 18, 2020 at 4:59
Add a comment
|
2 Answers
$\begingroup$
$\endgroup$
3
The key is in generating a BezierCurve or some such construct. Here is a version built by hand, just because this was more fun than the actual work I had to do right now :-)
blue = RGBColor[0.3, 0.45, 1]
green = RGBColor[0.25, 0.35, 0.15];
Show[{
Plot[Style[4 x - 2, Black, Dashed], {x, 0.5, 4}],
Plot[Style[1/2 x + 4, Black, Dashed], {x, 0, 2.5},
PlotStyle -> Dashed],
Plot[Style[1/2 x + 1, Black, Dashed], {x, -1, 1.5},
PlotStyle -> Dashed],
Graphics[{
blue, Thickness[0.01],
Arrowheads[{{0.06, 0.3}, {0.06, 0.95}}],
Arrow@BezierCurve[{{4, 14}, {2, 5.9}, {1.8, 4.8}, {0, 4}}]
}],
Graphics[{
green, Thickness[0.01],
Arrowheads[{{0.06, 0.97}}],
Arrow@BezierCurve[{{4, 14}, {0.8, 1}, {0.9, 1.3}, {-1, 0.5}}]
}],
Graphics[{
Inset[Style["Glass", 24], {0.8, 7}],
Inset[Style["Liquid", 24], {2.7, 12}],
blue,
Inset[Style[StandardForm@"\!\(\*SubscriptBox[\(q\), \(1\)]\)",
24], {0.5, 5.2}],
green,
Inset[Style[StandardForm@"\!\(\*SubscriptBox[\(q\), \(2\)]\)",
24], {-0.7, 1.5}]
}]
},
Frame -> True, Axes -> False,
FrameLabel -> {"T", "V, H"},
FrameStyle -> Directive[Black, 24, Thickness[0.01]],
FrameTicks -> {
{None, None},
{
{
{12/7,
Style[StandardForm@"\!\(\*SubscriptBox[\(T\), \(g1\)]\)", blue,
Bold],
{0.03, 0}, Thickness[0.01]},
{6/7,
Style[StandardForm@"\!\(\*SubscriptBox[\(T\), \(g2\)]\)", green,
Bold],
{0.03, 0}, Thickness[0.01]}},
None
}
},
PlotRange -> {{-1.5, 4.5}, {-2, 15}},
AspectRatio -> 0.8, ImageSize -> Large
]
-
$\begingroup$ MarcoB thank you very much! This is such an amazing code! I really appreciate it ! $\endgroup$– JohnCommented Nov 18, 2020 at 15:32
-
2$\begingroup$ @John You're very welcome. I was quite bored with whatever I was doing at the time. It was a nice diversion :-) $\endgroup$– MarcoBCommented Nov 18, 2020 at 17:04
-
$\begingroup$ MarcoB, if you happen to be bored again I would appreciate if you can help me with this slightly more difficult problem that I just posted: mathematica.stackexchange.com/questions/234958/… $\endgroup$– JohnCommented Nov 18, 2020 at 22:37
$\begingroup$
$\endgroup$
Using a slightly modified version of input data from MarcoB's answer we construct two BezierFunctions. With parametric functions finding the tangent line to a curve at a point and placing text labels becomes convenient:
bf1 = BezierFunction[{{4, 14}, {2, 5.9}, {1.8, 4.8}, {-1, 4}}];
bf2 = BezierFunction[{{4, 14}, {0.9, 1.3}, {0.5, 1.}, {-1, 0.5}}];
blue = RGBColor[0.3, 0.45, 1];
green = RGBColor[0.25, 0.35, 0.15];
prolog = {Text[Style[Subscript[q, 2], 16, blue], Offset[{0, 15}, bf1[.9]]],
Text[Style[Subscript[q, 1], 16, green], Offset[{0, 15}, bf2[.85]]],
Text[Style["Glass", 16, Gray], Offset[{-20, 20}, bf1[.2]]],
Text[Style["Liquid", 16, Gray], Offset[{-20, 40}, bf1[.8]]],
Dashed, InfiniteLine[bf1[.2], bf1'[.2]],
InfiniteLine[bf1[.9], bf1'[.9]],
InfiniteLine[bf2[.9], bf2'[.9]]};
Show[ParametricPlot[{bf1[t], bf2[t]}, {t, 0, 1},
PlotStyle -> Thread[{AbsoluteThickness[4],
{Arrowheads[{{.04, .75}, {0.04, .9}}], Arrowheads[{{.04, .2}, {.04, .75},
{0.04, .95}}]}, {blue, green}}],
AspectRatio -> 2/3, Frame -> True,
FrameTicks -> {{None, None}, {MapThread[{#, Style[##2]} &,
{{12, 6}/7, Subscript[T, #] & /@ {g1, g2} , {blue, green}}], None}},
FrameLabel -> {{"V, H", None}, {"T", None}}, LabelStyle -> 16,
FrameStyle -> Thick, Axes -> False] /. Line -> Arrow,
Prolog -> prolog,
ImageSize -> Large]
Two arbitrary parametric curves:
SeedRandom[123]
bf1 = BezierFunction[Reverse@SortBy[First]@RandomReal[{-5, 5}, {15, 2}]];
bf2 = {Cos[2 Pi #] , Sin[2Pi (1-#)]/#}&;
Show[ParametricPlot[{bf1[t], bf2[t]}, {t, 0, 1},
PlotStyle -> Thread[{AbsoluteThickness[4],
{Arrowheads[{{.04, .75}, {0.04, .9}}],
Arrowheads[{{.04, .2}, {.04, .65}, {0.04, .9}}]},
{blue, green}}],
AspectRatio -> 2/3, Frame -> True,
FrameTicks -> None, FrameStyle -> Thick, Axes -> False] /.
Line -> Arrow,
Epilog -> {AbsolutePointSize[10],
Text[Style[Subscript[q, 2], 16, blue], Offset[{-15, 15}, bf1[.5]]],
Text[Style[Subscript[q, 1], 16, green], Offset[{15, 15}, bf2[.2]]],
Dashed, Orange, InfiniteLine[bf1[.2], bf1'[.2]], Point[bf1[.2]],
Cyan, InfiniteLine[bf1[.5], bf1'[.5]], Point[bf1[.5]],
Magenta, InfiniteLine[bf2[.38], bf2'[.38]], Point[bf2[.38]]},
ImageSize -> Large]
