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!
{0, 0}
or very close. $\endgroup${0,0}
if you notice the diagram. $\endgroup$PlotRange
? E.g.PlotRange -> {{0, All}, {0, All}}
$\endgroup$