Mathematica Asked on December 16, 2020
How can I make a plot similar to the one below (enthalpy vs T plot) in Mathematica?
Thank you very much in advance
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
]
Correct answer by MarcoB on December 16, 2020
Using a slightly modified version of input data from MarcoB's answer we construct two BezierFunction
s. 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]
Answered by kglr on December 16, 2020
Get help from others!
Recent Questions
Recent Answers
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP