3
$\begingroup$

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

I want to achieve something similar to the following figure:

enter image description here

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:

enter image description here

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!

$\endgroup$
  • $\begingroup$ You can use Epilog option for Plot $\endgroup$ – Gae P Feb 18 at 13:52
  • $\begingroup$ 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. $\endgroup$ – MarcoB Feb 18 at 20:54
  • $\begingroup$ @MarcoB There is a slight extension after {0,0} if you notice the diagram. $\endgroup$ – Dimitris Feb 18 at 20:57
  • $\begingroup$ @dimitris Have you tried setting an explicit PlotRange? E.g. PlotRange -> {{0, All}, {0, All}} $\endgroup$ – MarcoB Feb 18 at 22:56
4
$\begingroup$
  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}] 

enter image description here

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

enter image description here

$\endgroup$
4
$\begingroup$

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

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.