Carnot cycle diagram

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,
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!

• You can use Epilog option for Plot Feb 18, 2019 at 13:52
• What do you mean by "the negative volume/pression extensions in the axis range"? It looks like your axis origin is already at {0, 0} or very close. Feb 18, 2019 at 20:54
• @MarcoB There is a slight extension after {0,0} if you notice the diagram. Feb 18, 2019 at 20:57
• @dimitris Have you tried setting an explicit PlotRange? E.g. PlotRange -> {{0, All}, {0, All}} Feb 18, 2019 at 22:56

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,
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[Red,
Arrowheads[{{-.07, 1/3, {Graphics[aRrow[Opacity[.5, Blue]]], 0}}, {-.05, 2/3}}]],
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}]


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]]
]
`