TransWikia.com

How to plot a schematic plot containing arbitrary smooth curves?

Mathematica Asked on December 16, 2020

How can I make a plot similar to the one below (enthalpy vs T plot) in Mathematica?

desired plot of phase transition

Thank you very much in advance

2 Answers

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
]

result of code above, resembling desired plot

Correct answer by MarcoB on December 16, 2020

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] 

enter image description here

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] 

enter image description here

Answered by kglr on December 16, 2020

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP