Carnot cycle diagram

Question

Note: I have adopted and modified code taken from Wolfram demonstration page.

I want to achieve something similar to the following figure:

I use the following code:

Clear["Global`*"]

R = 8.3145;

r[T2_, T1_, γ_] := (T2/T1)^(1/(γ - 1))

c1[T1_, T2_, V1_, V2_, γ_] := 
 Plot[(R T2)/(1000 V), {V, V1, V2}, PlotRange -> All, PlotStyle -> Red]

c3[T1_, T2_, V1_, V2_, γ_] := 
 Plot[(R T1)/(
  1000 V), {V, r[T2, T1, γ] V1, r[T2, T1, γ] V2}, 
  PlotRange -> All, PlotStyle -> Red]

c2[T1_, T2_, V1_, V2_, γ_] := 
 Plot[(R T2 V1^(γ - 1))/(
  1000 V^γ), {V, V1, r[T2, T1, γ] V1}, PlotRange -> All,
   PlotStyle -> Blue]

c4[T1_, T2_, V1_, V2_, γ_] := 
 Plot[(R T2 V2^(γ - 1))/(
  1000 V^γ), {V, V2, r[T2, T1, γ] V2}, PlotRange -> All,
   PlotStyle -> Blue]

carnot[T1_, T2_, V1_, V2_, γ_] := 
 Show[c2[T1, T2, V1, V2, γ], c4[T1, T2, V1, V2, γ], 
  c1[T1, T2, V1, V2, γ], c3[T1, T2, V1, V2, γ], 
  Frame -> False, Axes -> True, Ticks -> None, 
  AxesStyle -> Arrowheads[{0, 0.05}], 
  AxesLabel -> {Style["V", 14, Black], Style["P", 14, Black]}, 
  PlotRange -> {{Automatic, 12}, {Automatic, 1.6}}, 
  AxesOrigin -> {0, 0}, AspectRatio -> 1, ImageSize -> {285, 300}, 
  Epilog -> {{PointSize[Large], Point[{V1, ( R T2)/(1000 V1)}], 
     Point[{V2, ( R T2)/(1000 V2)}], 
     Point[{r[T2, T1, γ] V1, (R T2 V1^(γ - 1))/(
       1000 (r[T2, T1, γ] V1)^γ)}], 
     Point[{r[T2, T1, γ] V2, (R T2 V2^(γ - 1))/(
       1000 (r[T2, T1, γ] V2)^γ)}]}, {Style[
      Text[1, {V1, ( R T2)/(1000 V1) + 0.1}], 12, Black], 
     Style[Text[2, {V2, ( R T2)/(1000 V2) + 0.1}], 12, Black], 
     Style[Text[
       4, {r[T2, T1, γ] V1, (R T2 V1^(γ - 1))/(
         1000 (r[T2, T1, γ] V1)^γ) - 0.1}], 12, Black], 
     Style[
      Text[3, {r[T2, T1, γ] V2, (R T2 V2^(γ - 1))/(
         1000 (r[T2, T1, γ] V2)^γ) - 0.1}], 12, Black]}}]

carnot[250, 350, 2, 6, 5/3]

The last command gives:

I have two questions: How can I achieve the "heat flow arrows" as in the original picture and how can I get rid of the negative volume/pression extensions in the axis range? Thanks a lot!

Answer 1

1. You can plot all four functions using ParametricPlot after rescaling V for each function to run from 0 to 1 over the domain of the function.
2. You can use custom arrow heads to place the arrows at the desired scaled location on a curve. This approach also orients the arrows automatically.
3. You can place the node labels using Epilog as you did. Positioning the label at the center of the node eliminates the difficult challenge of calculating appropriate offsets as the positions of the nodes change dynamically.

First, two functions for rescaling the domains and for creating the arrow glyph:

ClearAll[reScale, aRrow, cArnot]
reScale[v_, range_] := Rescale[v, {0, 1}, range]
aRrow[style_: LightBlue] := {EdgeForm[Gray], FaceForm[style], 
  Polygon[{{-0.3, -0.5}, {-0.3, -0.2}, {-0.5, -0.2}, {0., 0.5}, {0.5, -0.2},
    {0.3, -0.2}, {0.3, -0.5}}]}

A single ParametricPlot containing all the elements:

cArnot[T1_, T2_, V1_, V2_, γ_] /; γ != 1 := Module[{
   f1 = {z, R T2/(1000 z)} /. z -> reScale[#, {V1, V2}] &, 
   f2 = {z, R T2 V1^(γ - 1)/(1000 z^γ)} /. z -> reScale[#, {V1, r[T2, T1, γ] V1}] &, 
   f3 = {z, R T1/(1000 z)} /. z -> reScale[#, {r[T2, T1, γ] V1, r[T2, T1, γ] V2}] &, 
   f4 = {z, R T2 V2^(γ - 1)/(1000 z^γ)} /. z -> reScale[#, {V2, r[T2, T1, γ] V2}] &},
  ParametricPlot[{f1[t], f2[t], f3[t], f4[t]}, {t, 0, 1}, 
    Frame -> False, Axes -> True, Ticks -> None, 
    AxesStyle -> Arrowheads[{0, 0.05}], 
    AxesLabel -> (Style[#, FontSize -> Scaled[.04], Black] & /@ {"V", "P"}),
    PlotStyle -> {Directive[Red, 
        Arrowheads[{{-.07, 2/3, {Graphics[aRrow[Opacity[.5, Red]]], 0}}, {.05, 1/3}}]],
       Directive[Blue, Arrowheads[{{-.05, 1/2}}]], 
       Directive[Red, 
        Arrowheads[{{-.07, 1/3, {Graphics[aRrow[Opacity[.5, Blue]]], 0}}, {-.05, 2/3}}]],
       Directive[Blue, Arrowheads[{{.05, 1/2}}]]},
    PlotRangePadding -> {{0, Scaled[.15]}, {0, Scaled[.15]}},
    PlotRange -> All, AxesOrigin -> {0, 0}, AspectRatio -> 1, 
    ImageSize -> 400, 
    Epilog -> {{Disk[#2, Scaled[.02]], 
       Text[Style[ToString[#], White, Bold, FontSize -> Scaled[.03]], #2]} & @@@ 
      Transpose[{Range[4], {f1[0], f4[0], f3[1], f3[0]}}]}] /. Line -> Arrow]

Examples:

Row[Show[cArnot[250, 350, #, 4, 5/3], ImageSize -> 300, 
    PlotLabel -> Column[Style[#, 14, Black] & /@ 
     {"{T1, T2, V2, γ} = " <> ToString[{250, 350, 4, 5/3}, StandardForm], 
         "V1 = " <> ToString[#]}, Center]] & /@ {1, 3, 10}] 

Manipulate[cArnot[t1, t2, v1, v2, g],
 {t1, 200, 250}, {{t2, 300}, 250, 400}, {v1, 1, 35}, {{v2, 3}, 1, 15}, {{g, 2}, 3/2, 5}]

Answer 2

One way to place the arrows is to define them as custom plot markers:

arrowR = {LightRed, EdgeForm[Black],
Polygon[{{0, 0}, {1, 0}, {1, 1}, {1.2, 1}, {0.5, 1.4}, {-0.2, 1}, {0, 1}}]};

arrowB = {LightBlue, EdgeForm[Black], 
Polygon[{{0, 0}, {1, 0}, {1, 1}, {1.2, 1}, {0.5, 1.4}, {-0.2,1}, {0, 1}}]};

Show[carnot[250, 350, 2, 6, 5/3],
   ListPlot[{{5, 0.7}}, PlotMarkers -> Graphics[Rotate[arrowR, 0.8 \[Pi]],
     ImageSize -> 20]], 
   ListPlot[{{4, 0.5}}, 
     PlotMarkers -> Graphics[Rotate[arrowB, 0.8 \[Pi]], ImageSize -> 20]]
]