Mathematica Asked by Indrasis Mitra on November 4, 2020
I am plotting temperature over a rectangular region of length $L$ and width $d$. $L>d$. The output of the contour plot is on a square.
(1) Can it be somehow adjusted to reflect the relative dimension of the domain? In other words can the plot be on a rectangle as the actual domain is.
(2) Can the contour labels be adjusted to fall inside the domain and not near the edges ?
I am including the code
ww = 0.095 10^-3; wc =
1.4 10^-3; d = 0.002; L = 0.030; u = 0.0104; cp = 4178; ks = 16; tfi = 300; q = 0.30005/2; rho = 997; h = 1931.39;
m = Sqrt[(h (2 (L + 0.5 ww)))/(ks 0.5 ww L)]; α = (2*h)/(cp*rho*u*wc); β = (2*h)/(ks*ww); p = Sqrt[α^2 + 4*β]; eta = Tanh[d*m]/(d*m); σ = d/wc;
qflux = 8603;
γ = (qflux*2*eta*σ*(wc + ww))/((2*eta*σ + 1)*ks*ww);
ζ1 = (qflux*(wc + ww))/(wc*(cp*d*rho*u));
TwnoAC[x_, y_] = (γ/m)*((Cosh[m (d - y)]/Sinh[m d])) + tfi + ζ1 x ;
ContourPlot[TwnoAC[x, y], {x, 0, L}, {y, 0, d}, ColorFunction -> "TemperatureMap", PlotLegends -> Automatic, PlotRange -> All, ContourLabels -> Function[{x, y, z}, Text[Framed[z], {x, y}, Background -> White]]]
The output is
After using flinty’s recommendation but using AspectRatio->0.50
, I got this (but the labels are still on the edges):
$Version
(* "12.1.1 for Mac OS X x86 (64-bit) (June 19, 2020)" *)
Clear["Global`*"]
ww = 95 10^-6;
wc = 14 10^-4;
d = 1/500;
L = 3/100;
u = 13/1250;
cp = 4178;
ks = 16;
tfi = 300;
q = 6001/40000;
rho = 997;
h = 193139/100;
m = Sqrt[(h (2 (L + ww/2)))/(ks ww L/2)];
α = (2*h)/(cp*rho*u*wc);
β = (2*h)/(ks*ww);
p = Sqrt[α^2 + 4*β]; eta = Tanh[d*m]/(d*m);
σ = d/wc;
qflux = 8603;
γ = (qflux*2*eta*σ*(wc + ww))/
((2*eta*σ + 1)*ks*ww);
ζ1 = (qflux*(wc + ww))/(wc*(cp*d*rho*u));
TwnoAC[x_, y_] = ((γ/m)*((Cosh[m (d - y)]/Sinh[m d])) +
tfi + ζ1 x // Simplify) /. r_Rational :> N[r]
(* 300 + 106.032 x + 0.0319017 Cosh[2256.25 (0.002 - y)] *)
The min and max values of the function are
{zMin, zMax} =
(#[{TwnoAC[x, y], 0 <= x <= L, 0 <= y <= d}, {x, y}] & /@
{MinValue,
MaxValue})
(* {300.032, 304.635} *)
midPt[z_?NumericQ] := midPt[z] = Module[{xc, yc},
yc = Mean[#[{y, TwnoAC[x, y] == z, 0 <= x <= L, 0 <= y <= d}, {x,
y}] & /@
{NMinValue, NMaxValue}];
xc = x /. Solve[{TwnoAC[x, yc] == z, 0 <= x <= L}, x][[1]];
{xc, yc}];
Pre-calculate midPt
for labels
midPt /@
(Range[300 + 1/2, 304 + 1/2, 1/2] /. r_Rational :> N[r]) //
Quiet;
Plot with the ColorFunction
rescaled and the ContourLabels
relocated
ContourPlot[TwnoAC[x, y], {x, 0, L}, {y, 0, d},
ColorFunction -> (ColorData["TemperatureMap"][Rescale[#, {zMin, zMax}]] &),
ColorFunctionScaling -> False,
PlotLegends -> Automatic,
PlotRange -> All,
ContourLabels -> Function[{x, y, z},
Text[If[z <= 304,
Framed[z], ""], midPt[z],
Background -> White]],
AspectRatio -> 0.5,
ImageSize -> Medium]
Correct answer by Bob Hanlon on November 4, 2020
cp = ContourPlot[TwnoAC[x, y], {x, 0, L}, {y, 0, d},
ColorFunction -> "TemperatureMap",
PlotLegends -> Placed[Automatic, Right], PlotRange -> All,
ImageSize -> Large, AspectRatio -> 1/2]
Post-process cp
to extract tooltips and contruct a graphics object with framed labels in the middle of the associated lines:
labels = Graphics @ Cases[Normal[cp],
Tooltip[{___, Line[x_], ___}, t_] :>
Text[Framed[t, Background -> White], BSplineFunction[x]@.5], All];
Show the two together:
Show[cp, labels, PlotRangeClipping -> False]
You can also rotate the labels based on curvature of the contour line using contour labels as custom Arrowheads
:
arrows = Graphics@ Cases[Normal[cp],
Tooltip[{style___, Line[x_], ___}, t_] :> {style,
FontColor -> Black, FontOpacity -> 1,
Arrowheads[{{.5, .5, Graphics@Text[Framed[t, Background -> White,
FrameStyle -> None]]}}], Arrow[SortBy[First]@x]}, All];
Show[cp, arrows, PlotRangeClipping -> False]
Answered by kglr on November 4, 2020
Get help from others!
Recent Questions
Recent Answers
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP