Tag: plotting

plotting – Replace the x axis of plot with desired number without changing the graph

I’ve read this Rescale axes (e.g change from Hz to THz), and tried to change my horizontal of the graph but was failed. I want the $x$-axis is added by $1945$ “Without changing the graph”.

For example if my interval is $xin(0,20)$, then my new interval should be $xin(1945, 1965)$. And plotting the graph on that interval, i wish the new graph wouldn’t change at all. So it’s just the numbers that changed.

Here is the picture that might help you to understand my question (sorry for bad drawing).

enter image description here

The step size of the interval should be the same

Here is my attempt:

pp := Plot(123456789 Exp(Log(163123123/123456789)/9 x), {x, -2, 69}, 
   Frame -> True);
fts = FrameTicks /. AbsoluteOptions(pp, FrameTicks);
fts((1)) = ReplaceAll(#, {tick_, lbl_, {pos_}, {style_}} :> {tick, 
       If(lbl == "", "", ToString(tick + (1945))), {pos}, {style}}) &@
   fts((1));
pp
Plot(123456789 Exp(Log(163123123/123456789)/9 x), {x, -2, 69}, 
 Frame -> True, FrameTicks -> fts)

plotting – Plot discrete points with a density value as individual rectangles

SeedRandom(1)

xy = RandomSample(Tuples(Range(0, 10), 2), 10);

z = RandomReal(1, 10);

xyz = Join(xy, List /@ z, 2)

{{9, 5, 0.941699}, {7, 3, 0.294264}, {1, 3, 0.188274}, {0, 0, 0.761529},
 {6, 1, 0.169824}, {0, 3, 0.455359}, {5, 10, 0.75425}, {9, 1, 0.268291},
 {2, 1, 0.147377}, {8, 9, 0.480659}}

Graphics

graphics = Graphics({EdgeForm(Gray), Hue @ #3, Rectangle({#, #2})} & @@@ xyz, 
 Frame -> True);

legend = SwatchLegend(Hue /@ xyz((All, -1)), Defer /@ xyz);

Legended(graphics, legend)

enter image description here

BubbleChart

BubbleChart(xyz, ChartStyle -> (Hue /@ xyz((All, -1))), 
 ChartElementFunction -> (Rectangle(Mean /@ #) &), 
 PlotRange -> {{0, 11}, {0, 11}}, 
 ChartLegends -> {Defer /@ xyz})

enter image description here

DensityHistogram

DensityHistogram(WeightedData(xyz((All, ;; 2)), xyz((All, -1))), {1}, 
 ColorFunction -> Hue, BaseStyle -> EdgeForm(Gray), 
 ChartElementFunction -> (Rectangle(Mean /@ #) &), 
 ColorFunctionScaling -> False, 
 ChartLegends -> SwatchLegend(Hue /@ xyz((All, -1)), Defer /@ xyz))

enter image description here

ListPlot

Legended(ReplaceAll(Point -> (Rectangle@*First))@
  ListPlot(List /@ xyz((All, ;; 2)), 
   PlotStyle -> Hue /@ xyz((All, -1)), BaseStyle -> EdgeForm(Gray), 
   AspectRatio -> 1, Frame -> True, PlotRange -> {{0, 10}, {0, 11}}, 
   PlotRangePadding -> .2), legend)

enter image description here

Update

To have “the plot legend to look something like the likes of DensityPlot/ArrayPlot”, replace legend above with barlegend1 or barlegend2, where

barlegend1 = BarLegend({Hue, MinMax@xyz((All, -1))});

barlegend2 = BarLegend({Hue, MinMax@xyz((All, -1))}, xyz((All, -1)));

Row({barlegend1, barlegend2}, Spacer(20))

enter image description here

Replace Hue with ColorData("M10DefaultDensityGradient") to use the default color scheme for DensityPlot:

barlegend1 = BarLegend({"M10DefaultDensityGradient", MinMax@xyz((All, -1))});
barlegend2 = BarLegend({"M10DefaultDensityGradient", MinMax@xyz((All, -1))}, 
   xyz((All, -1)));

Row({barlegend1, barlegend2}, Spacer(20))

enter image description here

Legended(Graphics({EdgeForm(Gray), Opacity(1), 
   ColorData("M10DefaultDensityGradient") @ #3, Rectangle({#, #2})} & @@@ xyz, 
   Frame -> True), 
  barlegend2)

enter image description here

BubbleChart(xyz, 
 ChartStyle -> (ColorData("M10DefaultDensityGradient") /@ xyz((All, -1))), 
 ChartElementFunction -> (Rectangle(Mean /@ #) &), 
 PlotRange -> {{0, 11}, {0, 11}}, ChartLegends -> barlegend2)

enter image description here

For DensityHistogram, just remove the option ColorFunction -> Hue:

DensityHistogram(WeightedData(xyz((All, ;; 2)), xyz((All, -1))), {1}, 
 ChartElementFunction -> (Rectangle(Mean /@ #) &), 
 ChartLegends -> BarLegend(Automatic, xyz((All, -1))))

enter image description here

plotting – I want a numerical and analytical solution of boundry value 2nd order differential equation

My equation is
x”(t)=-k/m(x-Ut)———–(1)
with x(0)=1 and x'(0)=0.
I want to calculate exact and numerical solutions of eq. (1) by using above given boundary conditions. Also want to plot both solutions with different values of t, m, k and U.
Please help me in this regard.

plotting – second order ODE and Numerical integration

This system can be solved exactly using DSolve.

Clear("Global`*")

$Version

(* "12.2.0 for Mac OS X x86 (64-bit) (December 12, 2020)" *)

Use exact values for the known parameters,

B = 2/5; C2 = 1/2; F = 3/5;

eqns = {y''(x) + A*y'(x) + B*y(x) + C2*y(x) == 0, 
  y(1) == 1, y'(0) == -1/5};

sol = DSolve(eqns, y, x);

Verifying the solution,

eqns /. sol // Simplify

(* {{True, True, True}} *)

The solution is then

sol2(A_, x_) = y(x) /. sol((1)) // FullSimplify

(* (E^(-(1/10) (5 A + Sqrt(-90 + 25 A^2)) x) (2 E^
      Sqrt(-(18/5) + A^2) + (-5 A + Sqrt(-90 + 25 A^2)) E^(
      1/10 (5 A + Sqrt(-90 + 25 A^2))) - 
     2 E^(Sqrt(-(18/5) + A^2) x) + (5 A + Sqrt(-90 + 25 A^2)) E^(
      1/10 (5 A + Sqrt(-90 + 25 A^2) (1 + 2 x)))))/(5 A (-1 + E^
      Sqrt(-(18/5) + A^2)) + Sqrt(-90 + 25 A^2) (1 + E^Sqrt(-(18/5) + A^2))) *)

Plotting,

Plot3D(sol2(A, x), {x, 0, 1}, {A, -1, 2},
 AxesLabel -> (Style(#, 14, Bold) & /@ {"x", "A", "y"}))

enter image description here

or

Plot(Evaluate(Tooltip(sol2(#, x), #) & /@ Range(-1, 1, 0.2)),
 {x, 0, 1},
 Frame -> True,
 FrameLabel ->
  (Style(#, 14, Bold) & /@ {"x", "y"}),
 PlotLegends -> LineLegend(Range(-1, 1, 0.25), LegendLabel -> "A"))

enter image description here

The requested integral is

int(A_) = Integrate(3*y(x) + F*y(x) /. sol((1)), {x, 0, 1}) // 
  FullSimplify

(* (8 E^(1/2 Sqrt(-(18/5) + 
     A^2)) ((1 + 5 A) Sqrt(-90 + 25 A^2)
       Cosh(A/2) - (1 + 5 A) Sqrt(-90 + 25 A^2)
       Cosh(1/2 Sqrt(-(18/5) + A^2)) + 
     45 Sinh(1/2 Sqrt(-(18/5) + A^2)) + (-1 + 
        5 A) (Sqrt(-90 + 25 A^2) Sinh(A/2) - 
        5 A Sinh(1/2 Sqrt(-(18/5) + A^2)))))/(5 (5 A (-1 + E^
        Sqrt(-(18/5) + A^2)) + 
     Sqrt(-90 + 25 A^2) (1 + E^Sqrt(-(18/5) + A^2)))) *)

Plotting,

Plot(int(A), {A, -1, 1},
 AxesLabel -> (Style(#, 14, Bold) & /@ {"A", "int"}))

enter image description here

plotting – List contour plot with peaks

I have this table that i imported this way

data = Import["C:\nivel\data.dat", "Table"]
xy = data[[All, {1, 2, 3}]]

And i wanted to make a list contour plot of it but got stuck in this:

ListContourPlot[xy, PlotTheme -> "Web", ColorFunction -> "DarkRainbow", PlotRange -> All]

enter image description here

This happens because over the red line the function values are much higher than the rest so i tried to get more definition in the blue part by using 2500 Contours, which apparently wasn´t the answer. I was trying to plot something like this:

enter image description here

I can´t find the way to show sort of information of the variations over the blue part which can be seen here, where the Plot Range wasn´t used but got that white line instead

enter image description here

plotting – Contour map without filled color

I would like to get a picture of a contour map like this:
enter image description here

I tried to modify the following code to remove the filled color on the contour map. So far I didn’t succeed.

 contourPotentialPlot1 = ContourPlot[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 
   0.275 h^2 s^2 + 0.125 s^4, {h, -400, 400}, {s, -300, 300}, 
 PlotRange -> {-1.4*10^8, 2*10^7}, Contours -> 15, Axes -> False, 
 PlotPoints -> 30, PlotRangePadding -> 0, Frame -> False, ColorFunction -> "DarkRainbow"];

potential1 = Plot3D[-3600. h^2 + 0.02974 h^4 - 5391.90 s^2 + 0.275 h^2 s^2 + 
    0.125 s^4, {h, -400, 400}, {s, -300, 300}, 
   PlotRange -> {-1.4*10^8, 2*10^7}, ClippingStyle -> None, 
   MeshFunctions -> {#3 &}, Mesh -> 15, MeshStyle -> Opacity[.5], 
   MeshShading -> {{Opacity[.3], Blue}, {Opacity[.8], Orange}}, Lighting -> "Neutral"];

level = -1.2 10^8; gr = Graphics3D[{Texture[contourPotentialPlot1], EdgeForm[], 
Polygon[{{-400, -300, level}, {400, -300, level}, {400, 300, level}, {-400, 300, level}}, 
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}, Lighting -> "Neutral"];

Show[potential1, gr, PlotRange -> All, BoxRatios -> {1, 1, .6}, FaceGrids -> {Back, Left}]

If we run the above code we would get a picture like this:
enter image description here

plotting – Plot showing unexpected behavior after some value of the variable

The function fun(y,z) defined below shows unexpected trend and falls abruptly after some value of z (note that y is fixed at 0.1). On checking explicitly the value of this function in this range, the Mathematica depicts "9.9115*10^-170 9.9115*10^-170 is too small to represent as a normalized machine number; precision may be lost"

    mat = {{1/2 + (Sqrt(1 - 4 y^2) Sinh(1/2 Sqrt(1 - 4 y^2) z))/(
     8 y^2 - 2 Cosh(1/2 Sqrt(1 - 4 y^2) z)), (
    2 I y Sinh(1/4 Sqrt(1 - 4 y^2) z)^2)/(
    4 y^2 - Cosh(1/2 Sqrt(1 - 4 y^2) z))}, {(
    2 I y Sinh(1/4 Sqrt(1 - 4 y^2) z)^2)/(-4 y^2 + 
     Cosh(1/2 Sqrt(1 - 4 y^2) z)), 
    1/2 (1 + (
       Sqrt(1 - 4 y^2) Sinh(1/2 Sqrt(1 - 4 y^2) z))/(-4 y^2 + 
        Cosh(1/2 Sqrt(1 - 4 y^2) z)))}};
dmat = D(mat, y);

e1 = {Eigenvalues(mat)((1))};
e2 = {Eigenvalues(mat)((2))};
de1 = Simplify(D(e1, y));
de2 = Simplify(D(e2, y));

v1 = Transpose({Eigenvectors(mat)((1))});
v2 = Transpose({Eigenvectors(mat)((2))});
v1ct = ConjugateTranspose(v1 );
v2ct = ConjugateTranspose(v2);

dv1 = Simplify(D(v1, y));
dv2 = Simplify(D(v2, y));

dv1ct = Simplify(ConjugateTranspose(dv1));
dv2ct = Simplify(ConjugateTranspose(dv2));

a = FullSimplify((de1*de1)/e1 + (de2*de2)/e2);

b = Simplify((2 (e1 - e2)^2)/(e1 + e2) Re((v1ct.dv2) (dv2ct.v1)));

c = Simplify((2 (e2 - e1)^2)/(e1 + e2) Re((v2ct.dv1) (dv1ct.v2)));

fun(y_, z_) = Simplify(a + b + c);

Plot(fun(0.1, z), {z, 0, 500})

plotting – Performance – Plot with Calloutmarker ->”Arrow” and ImageSize->Full

This is a little esoteric, but I noticed that using CalloutMarker -> "Arrow" on a Plot that uses ImageSize->Full causes huge performance problems (minutes vs fractions of a second) if Manipulate is used.

A minimal example to produce the behavior is shown below:

Manipulate(
 Plot(
  Callout(x, "x", CalloutMarker -> "Arrow"),
  {x, 0, 1},
  ImageSize -> Full
  ),
 {a}
 )

I am using version 12.1.1.

For now, I’ll just use a CalloutMarker other than “Arrow”, but does anybody have a workaround that accomplishes the intent of the above code, without taking forever?

Full" />

plotting – Can you explain strange behaviour of a plot masked with $(2*(-1 + Abs[x]))/(-2 + Abs[Abs[-1 + x] – Abs[1 + x]])$?

I made a code which draws a plot of $5-x^2$ masked with a kind of rectangular function in order to brake the branches of parabola at the points -1 and 1 and transform them into a vertical lines.

Clear("Global`*")
rgbC = RGBColor(0.880722, 0.611041, 0.142051);
pltS = {rgbC};
f = 2 - Abs(Abs(-1 + x) - Abs(1 + x)); 
(*triangular function with height 2 and base 2*)
lin = 2 - 
   Abs(2 x); (*auxiliary function to make rectangular function of 
triangular function*)
k = FullSimplify(
   lin/f); (*rectangular function with height 1 and base 2, defined 
on intervals x(-1,1) and y(1,-(Infinity))*)

eq1 = x^4;
eq2 = 5 - x^2 + k - 1;
fPlt = {Plot(I*x, {x, -2, 2}, AspectRatio -> Automatic, 
   PlotRange -> {{-2, 2}, {0, 
      5}})}; (*empty 'canvas' for applicating combined mPlt and uPlt*)


mPlt = {Plot({eq1}, {x, -3, 3}, Method -> "BoundaryOffset" -> False, 
   AspectRatio -> Automatic, Filling -> Top, 
   FillingStyle -> LightBlue, PlotRange -> {0, 3})};
uPlt = {Plot({eq2}, {x, -1.1, 1.1}, Method -> "BoundaryOffset" -> False, 
    PlotStyle -> {pltS}, PlotRange -> {{-2, 2}, {3, 5}}, 
    Filling -> Bottom, FillingStyle -> LightYellow)};

Show(fPlt, mPlt, uPlt)

The code works as expected when $x$ in uPlt varies from -1.1 to 1.1:

good

But things go curiouser when $x$ is bounded by -1 and 1, the vertical lines desappear:
strange

And it all becomes curiouser and curiouser with $x$ is ranging from -2 to 2, now the only left “leg” is absent. The circumstances are aggravated by the error message ‘infinite expression 1/0 encountered’ popping:
bad
Both legs are gowing back again with {x,-2,3} or {x,-3,3} and the error message persists.
What is going on?

plotting – Plot3D doesn’t generate the ellipitic paraboloid it’s supposed to

Clear("Global`*")

The default PlotRange is obscuring the detail that you want.

Plot3D((x - 1)^4 + (2 x + y)^2, {x, -8, 8}, {y, -8, 8},
 PlotRange -> {0, 6},
 ClippingStyle -> None)

enter image description here

ContourPlot((x - 1)^4 + (2 x + y)^2,
 {x, -8, 8}, {y, -8, 8},
 PlotRange -> {Full, Full, {0, 20}})

enter image description here