I wanted to plot a user-defined Piecewise function (pagoda function) in Mathematica 10.2.
It seems straightforward to me unfortunately the easy command leads to a bad result.
My first approach was:
f[x_] := Piecewise[{{0, x <= -1}, {-Abs[x] + 1, -1 < x < 1}, {0,
x >= 1}}]
Plot3D[ 5*f[x]*f[y], {x, -1.5, 1.5}, {y, -1.5, 1.5}]
I also tried to set MaxRecursion which lead to more terrible results in a few cases (e.g. 2,3).
Can anybody tell me how to plot this function in a smooth nice way?
Thanks,
Felix
As far as I can remember, making visible gaps was introduced as a feature. Before that, piecewise or discontinuous functions were plotted like this:
Plot[Piecewise[{{x, x <= 1}, {3, x > 1}}], {x, 0, 3}, Exclusions -> None]
That behavior gives the wrong impression. I would have to check when this was default or if I'm completely off here. Anyway, as already noted in the comments, you can use the Exclusions option to get connected graphs.
You don't need to increase PlotPoints because Mathematica will (hopefully always) recognize the boundaries of the pieces as places where it needs to recursively increase points. Therefore, the MaxRecursion option is far more important to give a smooth plot. This example was rendered with only 10 points, but a recursion value of 5:
Therefore, your function renders extremely well even with 10 plot-points when the recursion is high enough. Look how many subdivisions you get on the cracks
Plot3D[5*f[x]*f[y], {x, -1.5, 1.5}, {y, -1.5, 1.5}, PlotRange -> All,
Exclusions -> None, PlotPoints -> 10, MaxRecursion -> 6, Mesh -> All]
Finally, note that the gaps are not restricted to Piecewise functions. As you can verify yourself, UnitStep will also show gaps. You can try it with your example by using an undocumented function to turn everything to UnitStep:
Simplify`PWToUnitStep[5*f[x]*f[y]]
(*
5 (1 - Abs[x]) (1 - Abs[y]) (1 - UnitStep[-1 - x]) (1 -
UnitStep[-1 + x]) (1 - UnitStep[-1 - y]) (1 - UnitStep[-1 + y])
*)
With all due respect to #halirutan, by itself MaxRecursion set to 6 was not enough in the following plot to adjust the peak values of a piecewise function to be a monotonic increasing sequence:
This improved, when, in addition, I set PlotPoints to 240, as follows.
However, that does not completely solve all the display problems. For example, note in the plots above, that the initial value y = 0, is not correctly plotted as a blue vertical line despite use of Exclusions->None. Moreover, the grid lines, which are Dotted, do not display as dots, but as dashes which run off below the x-axis. All of these problems can be solved, probably more efficiently, by generating the points or dots as list data and using ListPlot or, as in this case ListLogPlot and using Joined->True when appropriate. That is low level solution, but is needed in more complicated plots to obtain a plot with shorter run time and more accessible control over the display features.
Related
Gauss function has an infinite number of jump discontinuities at x = 1/n, for positive integers.
I want to draw diagram of Gauss function.
Using Maxima cas I can draw it with simple command :
f(x):= 1/x - floor(1/x); plot2d(f(x),[x,0,1]);
but the result is not good ( near x=0 it should be like here)
Also Maxima claims:
plot2d: expression evaluates to non-numeric value somewhere in plotting
range.
I can define picewise function ( jump discontinuities at x = 1/n, for positive integers )
so I tried :
define( g(x), for i:2 thru 20 step 1 do if (x=i) then x else (1/x) - floor(1/x));
but it don't works.
I can also use chebyshew polynomials to aproximate function ( like in : A Graduate Introduction to Numerical Methods From the Viewpoint of Backward Error Analysis by Corless, Robert, Fillion, Nicolas)
How to do it properly ?
For plot2d you can set the adapt_depth and nticks parameters. The default values are 5 and 29, respectively. set_plot_option() (i.e. with no argument) returns the current list of option values. If you increase adapt_depth and/or nticks, then plot2d will use more points for plotting. Perhaps that makes the figure look good enough.
Another way is to use the draw2d function (in the draw package) and explicitly tell it to plot each segment. We know that there are discontinuities at 1/k, for k = 1, 2, 3, .... We have to decide how many segments to plot. Let's say 20.
(%i6) load (draw) $
(%i7) f(x):= 1/x - floor(1/x) $
(%i8) makelist (explicit (f, x, 1/(k + 1), 1/k), k, 1, 20);
(%o8) [explicit(f,x,1/2,1),explicit(f,x,1/3,1/2),
explicit(f,x,1/4,1/3),explicit(f,x,1/5,1/4),
explicit(f,x,1/6,1/5),explicit(f,x,1/7,1/6),
explicit(f,x,1/8,1/7),explicit(f,x,1/9,1/8),
explicit(f,x,1/10,1/9),explicit(f,x,1/11,1/10),
explicit(f,x,1/12,1/11),explicit(f,x,1/13,1/12),
explicit(f,x,1/14,1/13),explicit(f,x,1/15,1/14),
explicit(f,x,1/16,1/15),explicit(f,x,1/17,1/16),
explicit(f,x,1/18,1/17),explicit(f,x,1/19,1/18),
explicit(f,x,1/20,1/19),explicit(f,x,1/21,1/20)]
(%i9) apply (draw2d, %);
I have made a list of segments with ending points. The result is :
and full code is here
Edit: smaller size with shorter lists in case of almost straight lines,
if (n>20) then iMax:10 else iMax : 250,
in the GivePart function
I am trying to calculate two volumes which are related to each other. In this case as one volume increases it means more of the other volume is possible.
My code is as follows:
Plot[{(6.78966*10^22)(b)},{((9.0226522*10^22)(x))}, {(b, 0, 5.5*10^6),(x, 0, 5.5*10^6)}]
I want this to be plotted on one graph, so it can show the relationship of increasing one volume while the other decreases. However, I can't get this to display in wolfram alpha, a graphing calculator, or mathematica. It seems extremely simple and I am probably just making a dumb error.
The error that is being thrown by mathematica is: ( " cannot be followed by " b,0,5.5*10^6)
But when I try it without the parenthesis it says I do not have enough rules to define my function. Is there a better way to do this?
What I am trying to do is find how many cm^3 of plutonium is needed to convert cm^3 of cadmium. I have done the relationships, but now I am trying to plot it. The maximum volume that can be utilized is 5.5*10^6. So I want one line to end when all of the cm^3 of the volume are cadmium and the other to end when all of the cm^3 is plutonium. This will allow me to find the point in which they intersect optimizing my problem.
Taking the maximum volume, m
m = 5.5*10^6;
Plot[{6.78966*10^22 (m - x), 9.0226522*10^22 x}, {x, 0, m}]
Solve[6.78966*10^22 (m - x) == 9.0226522*10^22 x, x]
{{x -> 2.36165*10^6}}
I've got a list of three dimensional points, ordered by time. Is there a way to plot the points so that I can get a visual representation that also includes information on where in the list the point occurred? My initial thought is to find a way to color the points by the order in which they were plotted.
ListPlot3D drapes a sheet over the points, with no regard to the order which they were plotted.
ListPointPlot just shows the points, but gives no indication as to the order in which they were plotted. It's here that I am thinking of coloring the points according to the order in which they appear in the list.
ListLinePlot doesn't seem to have a 3D cousin, unlike a lot of the other plotting functions.
You could also do something like
lst = RandomReal[{0, 3}, {20, 3}];
Graphics3D[{Thickness[0.005],
Line[lst,
VertexColors ->
Table[ColorData["BlueGreenYellow"][i], {i,
Rescale[Range[Length[lst]]]}]]}]
As you did not provide examples, I made up some by creating a 3d self-avoiding random walk:
Clear[saRW3d]
saRW3d[steps_]:=
Module[{visited},
visited[_]=False;
NestList[
(Function[{randMove},
If[
visited[#+randMove]==False,
visited[#+randMove]=True;
#+randMove,
#
]
][RandomChoice[{{1,0,0},{-1,0,0},{0,1,0},{0,-1,0},{0,0,1},{0,0,-1}}]])&,
{0,0,0},
steps
]//DeleteDuplicates
]
(this is sort of buggy but does the job; it produces a random walk in 3d which avoids itself, ie, avoids revisiting the same place in subsequent steps).
Then we produce 100000 steps like this
dat = saRW3d[100000];
this is like I understood your data points to be. We then make these change color depepnding on which step it is:
datpairs = Partition[dat, 2, 1];
len = Length#datpairs;
dressPoints[pts_, lspec_] := {RGBColor[(N#First#lspec)/len, 0, 0],
Line#pts};
datplt = MapIndexed[dressPoints, datpairs];
This can also be done all at once like the other answers
datplt=MapIndexed[
{RGBColor[(N#First##2)/Length#dat, 0, 0], Line##1} &,
Partition[dat, 2, 1]
]
but I tend to avoid this sort of constructions because I find them harder to read and modify.
Finally plot the result:
Graphics3D[datplt]
The path gets redder as time advances.
If this is the sort of thing you're after, I can elaborate.
EDIT: There might well be easier ways to do this...
EDIT2: Show a large set of points to demonstrate that this is very useful to see the qualitative trend in time in cases where arrows won't scale easily.
EDIT3: Added the one-liner version.
I think Heike's method is best, but she made it overly complex, IMHO. I would use:
Graphics3D[{
Thickness[0.005],
Line[lst,
VertexColors ->
ColorData["SolarColors"] /# Rescale#Range#Length#lst ]
}]
(acl's data)
Graphics3D#(Arrow /# Partition[RandomInteger[{0, 10}, {10, 3}], 2, 1])
As to your last question: If you want to have a kind of ListLinePlot3D instead of a ListPointPlot you could simply do the following:
pointList =
Table[{t, Sin[t] + 5 Sin[t/10], Cos[t] + 5 Cos[t/10],
t + Cos[t/10]}, {t, 0, 100, .5}];
ListPointPlot3D[pointList[[All, {2, 3, 4}]]] /. Point -> Line
Of course, in this way you can't set line properties so you have to change the rule a bit if you want that:
ListPointPlot3D[pointList[[All, {2, 3, 4}]]] /.
Point[a___] :> {Red, Thickness[0.02], Line[a]}
or with
ListPointPlot3D[pointList[[All, {2, 3, 4}]]] /.
Point[a___] :> {Red, Thickness[0.002], Line[a], Black, Point[a]}
But then, why don't you use just Graphics3D and a few graphics primitives?
I have a few differential equations that I'd like to draw solutions for, for a variety of start values N_0
Here are the equations:
dN\dt= bN^2 - aN
dN\dt = bN^2 (1 - N\K) - aN
How would I go about it?
I don't really care about the language is used. In terms of dedicated math I have mathematica and matlab on my computer. I've got access to maple. I have to do more of this stuff, and I'd like to have examples from any language, as it'll help me figure out which one I want to use and learn it.
I'll pretend the first one cannot be solved analytically so as to show how one would go about playing with a general ODE in mathematica.
Define
p1[n0_, a_, b_, uplim_: 10] :=(n /. First#NDSolve[
{n'[t] == b*n[t]^2 - a*n[t], n[0] == n0},n, {t, 0, uplim}]
which returns the solution of the ODE, i.e., a = p1[.1, 2., 3.] and then e.g. a[.3] tells you n(.3). One can then do something like
Show[Table[ans = p1[n0, 1, 1];
Plot[ans[t], {t, 0, 10}, PlotRange \[Rule] Full],
{n0, 0, 1, .05}], PlotRange \[Rule] {{0, 5}, {0, 1}}]
which plots a few solutions with different initial values:
or, to gain some insight into the solutions, one can interactively manipulate the values of a, b and n0:
Manipulate[
ans = p1[n0, a, b];
Plot[ans[t], {t, 0, 10},PlotRange -> {0, 1}],
{{n0, .1}, 0, 1},
{{a, 1}, 0, 2},
{{b, 1}, 0, 2}]
which gives something like
with the controls active (i.e. you move them and the plot changes; try it live to see what I mean; note that you can set parameters for which the initial conditions gives diverging solutions).
Of course this can be made arbitrarily more complicated. Also in this particular case this ODE is easy enough to integrate analytically, but this numerical approach can be applied to generic ODEs (and many PDEs, too).
Adding to the several good answers, if you just want a quick sketch of an ODE's solutions for many starting values, for guidance, you can always do a one-line StreamPlot. Suppose a==1 and b==1, and dy/dx == x^2 - x.
StreamPlot[{1, x^2 - x}, {x, -3, 3}, {y, -3, 3}]
StreamStyle -> "Line" will give you just lines, no arrows.
In Mathematica you use NDSolve (unless it can be solved analytically, in which case you use DSolve. So for your first equation I tried:
b = 1.1; a = 2;
s = NDSolve[{n'[t] == b n[t]^2 - a n[t], n[0] == 1}, n, {t, 0, 10}];
Plot[Evaluate[n[t] /. s], {t, 1, 10}, PlotRange -> All]
I didn't know what to use for a, b or N0, but I got this result:
If you're happy to solve the equations numerically, MATLAB has a set of ODE solvers that might be useful. Check out the documentation for the ode45 function here.
The general approach is to define an "ode function" that describes the right-hand-side of the differential equations. You then pass this function, along with initial conditions and an integration range to the ode solvers.
One attractive feature of this type of approach is that it extends in a straight-forward way to complex systems of coupled ODE's.
Hope this helps.
I have two approximated functions and I want to find the maximum value (error) between their graphs, to see how much they approach. I used :
FindMaximum[Abs[f[x] - p[x]], x], but Mathematica 8 gave me that output:
{2.75612*10^104, {x -> 2.75612*10^104}}
what does this mean? It is too big!
can you suggest me a better way?
Thanks
It's hard to tell not knowing your functions, but I'd guess that the position of the maximum it found is well outside your intended domain. You may have more success using a different form or FindMaximum, namely
FindMaximum[Abs[f[x] - p[x]],{x,x0,xmin,xmax}]
where x0 would be your initial guess for it (can be any point inside the region of interest), and xmin,xmax are the endpoints of your region of interest.
The reason is probably what Leonid said. To look at what FindMaximum is doing in real time, you can do
f[x_] := Sin[x];
p[x_] := x^2;
lst = {};
Monitor[
FindMaximum[Abs[f[x] - p[x]], x,
EvaluationMonitor :> (AppendTo[lst, x]; Pause[.01])
], ListPlot[lst, PlotRange -> Full]
]
the vertical axis on the resulting plot is the x-coordinate FindMaximum is currently looking at. Once FindMaximum is done, the plot disappears; the list is stored in lst so you can eg ListPlot it.
You can also try this with {Abs[f[x] - p[x]], -1 <= x <= 1} as the argument, as suggested by Spencer Nelson, to see how the search proceeds then.
This is probably caused by some sort of overflow in one of the two functions when the input value of x is a very large number. You should restrict your domain to [-1, 1]:
FindMaximum[{Abs[f[x] - p[x]], -1 <= x <= 1}, x]
If you want to search for a global maximum within the interval {a, b}, I suggest NMaximize:
NMaximize[{Abs[f[x] - p[x]], a <= x <= b}, x].
Note that FindMaximum searches for any local maximum, which is only good if you know that, for your particular function, a local maximum would also be a global maximum.
Instead of the objective function Abs[f[x] - p[x]], you may wish to use the objective function (f[x] - p[x])^2. This would make the objective function smooth (if f[x] and p[x] are smooth), which can help improve the efficiency of some numerical optimization methods.