I am having some problems in plotting this. Everything is ok until the plot statement where nothing plots. Can someone please help me so that it can plot something. The following is my code:
j = 10;
s = 0; r = 0;
B[n_] = Integrate[2*Sin[n*Pi*x]*(x), {x, 0, 1}];
u[x_, psi_] = Sum[B[n]*Sin[n*Pi*x]*Exp[-(n*Pi)^2*psi], {n, 1, j}];
K[x_, psi_] =
Sum[Sin[n*Pi*x]*
Sin[n*Pi*
psi]*(2*Exp[-(n*Pi)^2*
Abs[s + r]] - (Exp[-(n*Pi)^2*Abs[s - r]] -
Exp[-(n*Pi)^2*(s + r)])/(n*Pi)^2 ), {n, 1, j}];
w = RandomReal[NormalDistribution[0, 1], 101];
d = Round[100*x + 1];
S = Total[Total[u[x, psi]/Length[u[x, psi]]] + w[d]]
T[x_, psi_] = Integrate[K[x - y, psi]*(y)*S, {y, -10, 10}]
Plot3D[T[x, psi], {x, 0, 1}, {psi, 0.01, 1},
AxesLabel -> {"x", "t", "Temperature"}, Boxed -> False,
Mesh -> False]
Basically, I have some data from "u" and I want to make it noisy (from "w") for each "x" value and then perform the convolution in "T" and plot.
I will really appreciate anyone's kind help.
Thanks very much!
I'm not sure that I understand the problem you're trying to solve. However, modifying your code as shown below allows it to run - I rephrased several expression to be functions (a good rule of thumb is to use := if the left hand side involves a pattern, like B[n_]) and I removed some code that was apparently trying to treat scalars as vectors.
j = 10; s = 0; r = 0;
ClearAll[B];
B[n_] := B[n] = Integrate[2*Sin[n*Pi*a]*(a), {a, 0, 1}];
ClearAll[u];
u[x_, psi_] := Sum[B[n]*Sin[n*Pi*x]*Exp[-(n*Pi)^2*psi], {n, 1, j}];
K[x_, psi_] :=
Sum[Sin[n*Pi*x]*
Sin[n*Pi*
psi]*(2*Exp[-(n*Pi)^2*Abs[s + r]] - (Exp[-(n*Pi)^2*Abs[s - r]] -
Exp[-(n*Pi)^2*(s + r)])/(n*Pi)^2), {n, 1, j}];
S[x_, psi_] := u[x, psi] + RandomReal[NormalDistribution[]]
T[x_, psi_] := Integrate[K[x - y, psi]*(y)*S[x, psi], {y, -10, 10}]
Plot3D[T[x, psi], {x, 0, 1}, {psi, 0.01, 1},
AxesLabel -> {"x", "t", "Temperature"}, Boxed -> False,
Mesh -> False]
After running for some time (~ 1 hour) it produces the plot below
There is probably a much more efficient way to produce this plot using a more idiomatic approach. If you could provide more detailed information about what you're trying to do with the code you posted, then maybe I or others could give you a more useful answer.
It looks very much as if you are using = where you should be using :=. The former makes an immediate assignment (called Set) the other a delayed assignment (SetDelayed). The difference is fundamental in Mathematica, you should read the documentation until you understand this difference thoroughly.
Here is a template solution based on the outline of your question:
data = RandomInteger[{0, 1}, 100]; (* data creation function *)
noise = RandomVariate[NormalDistribution[0, 1], Length#data]; (* noise vector *)
noisyData = data + noise; (* sum noise and data *)
ListConvolve[data, noisyData] (* apply convolution *)
{8.20928}
How does this prototype match with your goals ?
I've been learning Sow/Reap. They are cool constructs. But I need help to see if I can use them to do what I will explain below.
What I'd like to do is: Plot the solution of NDSolve as it runs. I was thinking I can use Sow[] to collect the solution (x,y[x]) as NDSolve runs using EvaluationMonitor. But I do not want to wait to the end, Reap it and then plot the solution, but wanted to do it as it is running.
I'll show the basic setup example
max = 30;
sol1 = y /.
First#NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1},
y, {x, 0, max}];
Plot[sol1[x], {x, 0, max}, PlotRange -> All, AxesLabel -> {"x", "y[x]"}]
Using Reap/Sow, one can collect the data points, and plot the solution at the end like this
sol = Reap[
First#NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1},
y, {x, 0, max}, EvaluationMonitor :> Sow[{x, y[x]}]]][[2, 1]];
ListPlot[sol, AxesLabel -> {"x", "y[x]"}]
Ok, so far so good. But what I want is to access the partially being build list, as it accumulates by Sow and plot the solution. The only setup I know how do this is to have Dynamic ListPlot that refreshes when its data changes. But I do not know how to use Sow to move the partially build solution to this data so that ListPlot update.
I'll show how I do it without Sow, but you see, I am using AppenedTo[] in the following:
ClearAll[x, y, lst];
max = 30;
lst = {{0, 0}};
Dynamic[ListPlot[lst, Joined -> False, PlotRange -> {{0, max}, All},
AxesLabel -> {"x", "y[x]"}]]
NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1}, y, {x, 0, max},
EvaluationMonitor :> {AppendTo[lst, {x, y[x]}]; Pause[0.01]}]
I was thinking of a way to access the partially build list by Sow and just use that to refresh the plot, on the assumption that might be more efficient than AppendTo[]
I can't just do this:
ClearAll[x, y, lst];
max = 30;
lst = {{0, 0}};
Dynamic[ListPlot[lst, Joined -> False, PlotRange -> All]]
NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1}, y, {x, 0, max},
EvaluationMonitor :> {lst = Reap[Sow[{x, y[x]}] ][[2, 1]]; Pause[0.01]}]
Since it now Sow one point, and Reap it, so I am just plotting one point at a time. The same as if I just did:
NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1}, y, {x, 0, max},
EvaluationMonitor :> {lst = Sow[{x, y[x]}]; Pause[0.01]}]
my question is, how to use Sow/Reap in the above, to avoid me having manage the lst by the use of AppendTo in this case. (or by pre-allocation using Table, but then I would not know the size to allocate) Since I assume that may be Sow/Reap would be more efficient?
ps. What would be nice, if Reap had an option to tell it to Reap what has been accumulated by Sow, but do not remove it from what has been Sow'ed so far. Like a passive Reap sort of. Well, just a thought.
thanks
Update: 8:30 am
Thanks for the answers and comments. I just wanted to say, that the main goal of asking this was just to see if there is a way to access part of the data while being Sowed. I need to look more at Bag, I have not used that before.
Btw, The example shown above, was just to give a context to where such a need might appear. If I wanted to simulate the solution in this specific case, I do not even have to do it as I did, I could obtain the solution data first, then, afterwords, animate it.
Hence no need to even worry about allocation of a buffer myself, or use AppenedTo. But there could many other cases where it will be easier to access the data as it is being accumulated by Sow. This example is just what I had at the moment.
To do this specific example more directly, one can simply used Animate[], afterwords, like this:
Remove["Global`*"];
max = 30;
sol = Reap[
First#NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1},
y, {x, 0, max}, EvaluationMonitor :> Sow[{x, y[x]}]]][[2, 1]];
Animate[ListPlot[sol[[1 ;; idx]], Joined -> False,
PlotRange -> {{0, max}, All}, AxesLabel -> {"x", "y[x]"}], {idx, 1,
Length[sol], 1}]
Or, even make a home grown animate, like this
Remove["Global`*"];
max = 30;
sol = Reap[
First#NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1},
y, {x, 0, max}, EvaluationMonitor :> Sow[{x, y[x]}]]][[2, 1]];
idx = 1;
Dynamic[idx];
Dynamic[ListPlot[sol[[1 ;; idx]], Joined -> False,
PlotRange -> {{0, max}, All}, AxesLabel -> {"x", "y[x]"}]]
Do[++idx; Pause[0.01], {i, 1, Length[sol] - 1}]
Small follow up question: Can one depend on using Internal``Bag now? Since it is in Internal context, will there be a chance it might be removed/changed/etc... in the future, breaking some code? I seems to remember reading somewhere that this is not likely, but I do not feel comfortable using something in Internal Context. If it is Ok for us to use it, why is it in Internal context then?
(so many things to lean in Mathematica, so little time)
Thanks,
Experimentation shows that both Internal`Bag and linked lists are slower than using AppendTo. After considering this I recalled what Sasha told me, which is that list (array) creation is what takes time.
Therefore, neither method above, nor a Sow/Reap in which the result is collected as a list at each step is going to be more efficient (in fact, less) than AppendTo.
I believe that only array pre-allocation can be faster among the native Mathematica constructs.
Old answer below for reference:
I believe this is the place for Internal`Bag, Internal`StuffBag, and Internal`BagPart.
I had to resort to a clumsy double variable method because the Bag does not seem to update inside Dynamic the way I expected.
ClearAll[x, y, lst];
max = 30;
bag = Internal`Bag[];
lst = {{}};
Dynamic#ListPlot[lst, Joined -> False, PlotRange -> All]
NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1}, y, {x, 0, max},
EvaluationMonitor :> {Internal`StuffBag[bag, {x, y[x]}];
lst = Internal`BagPart[bag, All];
Pause[0.01]}
]
I'd like to ask if the following way I manage plotting result of simulation is efficient use of Mathematica and if there is a more 'functional' way to do it. (may be using Sow, Reap and such).
The problem is basic one. Suppose you want to simulate a physical process, say a pendulum, and want to plot the time-series of the solution (i.e. time vs. angle) as it runs (or any other type of result).
To be able to show the plot, one needs to keep the data points as it runs.
The following is a simple example, that plots the solution, but only the current point, and not the full time-series:
Manipulate[
sol = First#NDSolve[{y''[t] + 0.1 y'[t] + Sin[y[t]] == 0, y[0] == Pi/4, y'[0] == 0},
y, {t, time, time + 1}];
With[{angle = y /. sol},
(
ListPlot[{{time, angle[time]}}, AxesLabel -> {"time", "angle"},
PlotRange -> {{0, max}, {-Pi, Pi}}]
)
],
{{time, 0, "run"}, 0, max, Dynamic#delT, ControlType -> Trigger},
{{delT, 0.1, "delT"}, 0.1, 1, 0.1, Appearance -> "Labeled"},
TrackedSymbols :> {time},
Initialization :> (max = 10)
]
The above is not interesting, as one only sees a point moving, and not the full solution path.
The way currently I handle this, is allocate, using Table[], a buffer large enough to hold the largest possible time-series size that can be generated.
The issue is that the time-step can change, and the smaller it is, the more data will be generated.
But since I know the smallest possible time-step (which is 0.1 seconds in this example), and I know the total time to run (which is 10 seconds here), then I know how much to allocate.
I also need an 'index' to keep track of the buffer. Using this method, here is a way to do it:
Manipulate[
If[time == 0, index = 0];
sol = First#NDSolve[{y''[t] + 0.1 y'[t] + Sin[y[t]] == 0, y[0] == Pi/4,y'[0] == 0},
y, {t, time, time + 1}];
With[{angle = y /. sol},
(
index += 1;
buffer[[index]] = {time, angle[time]};
ListPlot[buffer[[1 ;; index]], Joined -> True, AxesLabel -> {"time", "angle"},
PlotRange -> {{0, 10}, {-Pi, Pi}}]
)
],
{{time, 0, "run"}, 0, 10, Dynamic#delT, AnimationRate -> 1, ControlType -> Trigger},
{{delT, 0.1, "delT"}, 0.1, 1, 0.1, Appearance -> "Labeled"},
{{buffer, Table[{0, 0}, {(max + 1)*10}]}, None},
{{index, 0}, None},
TrackedSymbols :> {time},
Initialization :> (max = 10)
]
For reference, when I do something like the above in Matlab, it has a nice facility for plotting, called 'hold on'. So that one can plot a point, then say 'hold on' which means that the next plot will not erase what is already on the plot, but will add it.
I did not find something like this in Mathematica, i.e. update a current plot on the fly.
I also did not want to use Append[] and AppendTo[] to build the buffer as it runs, as that will be slow and not efficient.
My question: Is there a more efficient, Mathematica way (which can be faster and more elegent) to do a typical task such as the above, other than what I am doing?
thanks,
UPDATE:
On the question on why not solving the ODE all at once.
Yes, it is possible, but it simplifies things alot to do it in pieces, also for performance reasons.
Here is an example with ode with initial conditions:
Manipulate[
If[time == 0, index = 0];
sol = First#
NDSolve[{y''[t] + 0.1 y'[t] + Sin[y[t]] == 0, y[0] == y0,
y'[0] == yder0}, y, {t, time, time + 1}];
With[{angle = (y /. sol)[time]},
(
index += 1;
buffer[[index]] = {time, angle};
ListPlot[buffer[[1 ;; index]], Joined -> True,
AxesLabel -> {"time", "angle"},
PlotRange -> {{0, 10}, {-Pi, Pi}}])],
{{time, 0, "run"}, 0, 10, Dynamic#delT, AnimationRate -> 1,
ControlType -> Trigger}, {{delT, 0.1, "delT"}, 0.1, 1, 0.1,
Appearance -> "Labeled"},
{{y0, Pi/4, "y(0)"}, -Pi, Pi, Pi/100, Appearance -> "Labeled"},
{{yder0, 0, "y'(0)"}, -1, 1, .1, Appearance -> "Labeled"},
{{buffer, Table[{0, 0}, {(max + 1)*10}]}, None},
{{index, 0}, None},
TrackedSymbols :> {time},
Initialization :> (max = 10)
]
Now, in one were to solve the system once before, then they need to watch out if the IC changes. This can be done, but need extra logic and I have done this before many times, but it does complicate things a bit. I wrote a small note on this here.
Also, I noticed that I can get much better speed by solving the system for smaller time segments as time marches on, than the whole thing at once. NDSolve call overhead is very small. But when the time duration to NDsolve for is large, problems can result when one ask for higher accuracy from NDSolve, as in options AccuracyGoal ->, PrecisionGoal ->, which I could not when time interval is very large.
Overall, the overhead of calling NDSolve for smaller segments seems to much less compare to the advantages it makes in simplifing the logic, and speed (may be more accurate, but I have not checked on this more). I know it seems a bit strange to keep calling NDSolve, but after trying both methods (all at once, but add logic to check for other control variables) vs. this method, I am now leaning towards this one.
UPDATE 2
I compared the following 4 methods for 2 test cases:
tangle[j][j] method (Belisarius)
AppendTo (suggested by Sjoerd)
Dynamic linked list (Leonid) (with and without SetAttributes[linkedList, HoldAllComplete])
preallocate buffer (Nasser)
The way I did this, is by running it over 2 cases, one for 10,000 points, and the second for 20,000 points. I did leave the Plot[[] command there, but do not display it on the screen, this is to eliminate any overhead of the actual rendering.
I used Timing[] around a Do loop which iterate over the core logic which called NDSolve and iterate over the time span using delT increments as above. No Manipulate was used.
I used Quit[] before each run.
For Leonid method, I changed the Column[] he had by the Do loop. I verified at the end, but plotting the data using his getData[] method, that the result is ok.
All the code I used is below. I made a table which shows the results for the 10,000 points and 20,000. Timing is per seconds:
result = Grid[{
{Text[Style["method", Bold]],
Text[Style["number of elements", Bold]], SpanFromLeft},
{"", 10000, 20000},
{"", SpanFromLeft},
{"buffer", 129, 571},
{"AppendTo", 128, 574},
{"tangle[j][j]", 612, 2459},
{"linkedList with SetAttribute", 25, 81},
{"linkedList w/o SetAttribute", 27, 90}}
]
Clearly, unless I did something wrong, but code is below for anyone to verify, Leonid method wins easily here. I was also surprised that AppendTo did just as well as the buffer method which pre-allocated data.
Here are the slightly modified code I used to generate the above results.
buffer method
delT = 0.01; max = 100; index = 0;
buffer = Table[{0, 0}, {(max + 1)*1/delT}];
Timing[
Do[
sol = First#
NDSolve[{y''[t] + 0.1 y'[t] + Sin[y[t]] == 0, y[0] == Pi/4,
y'[0] == 0}, y, {t, time, time + 1}];
With[{angle = y /. sol},
(index += 1;
buffer[[index]] = {time, angle[time]};
foo =
ListPlot[buffer[[1 ;; index]], Joined -> True,
AxesLabel -> {"time", "angle"},
PlotRange -> {{0, 10}, {-Pi, Pi}}]
)
], {time, 0, max, delT}
]
]
AppendTo method
Clear[y, t];
delT = 0.01; max = 200;
buffer = {{0, 0}}; (*just a hack to get ball rolling, would not do this in real code*)
Timing[
Do[
sol = First#
NDSolve[{y''[t] + 0.1 y'[t] + Sin[y[t]] == 0, y[0] == Pi/4,
y'[0] == 0}, y, {t, time, time + 1}];
With[{angle = y /. sol},
(AppendTo[buffer, {time, angle[time]}];
foo =
ListPlot[buffer, Joined -> True, AxesLabel -> {"time", "angle"},
PlotRange -> {{0, 10}, {-Pi, Pi}}]
)
], {time, 0, max, delT}
]
]
tangle[j][j] method
Clear[y, t];
delT = 0.01; max = 200;
Timing[
Do[
sol = First#
NDSolve[{y''[t] + 0.1 y'[t] + Sin[y[t]] == 0, y[0] == Pi/4,
y'[0] == 0}, y, {t, time, time + 1}];
tangle[time] = y /. sol;
foo = ListPlot[
Table[{j, tangle[j][j]}, {j, .1, max, delT}],
AxesLabel -> {"time", "angle"},
PlotRange -> {{0, max}, {-Pi, Pi}}
]
, {time, 0, max, delT}
]
]
dynamic linked list method
Timing[
max = 200;
ClearAll[linkedList, toLinkedList, fromLinkedList, addToList, pop,
emptyList];
SetAttributes[linkedList, HoldAllComplete];
toLinkedList[data_List] := Fold[linkedList, linkedList[], data];
fromLinkedList[ll_linkedList] :=
List ## Flatten[ll, Infinity, linkedList];
addToList[ll_, value_] := linkedList[ll, value];
pop[ll_] := Last#ll;
emptyList[] := linkedList[];
Clear[getData];
Module[{ll = emptyList[], time = 0, restart, plot, y},
getData[] := fromLinkedList[ll];
plot[] := Graphics[
{
Hue[0.67`, 0.6`, 0.6`],
Line[fromLinkedList[ll]]
},
AspectRatio -> 1/GoldenRatio,
Axes -> True,
AxesLabel -> {"time", "angle"},
PlotRange -> {{0, 10}, {-Pi, Pi}},
PlotRangeClipping -> True
];
DynamicModule[{sol, angle, llaux, delT = 0.01},
restart[] := (time = 0; llaux = emptyList[]);
llaux = ll;
sol :=
First#NDSolve[{y''[t] + 0.1 y'[t] + Sin[y[t]] == 0, y[0] == Pi/4,
y'[0] == 0}, y, {t, time, time + 1}];
angle := y /. sol;
ll := With[{res =
If[llaux === emptyList[] || pop[llaux][[1]] != time,
addToList[llaux, {time, angle[time]}],
(*else*)llaux]
},
llaux = res
];
Do[
time += delT;
plot[]
, {i, 0, max, delT}
]
]
]
]
thanks for everyone help.
I don't know how to get what you want with Manipulate, but I seem to have managed getting something close with a custom Dynamic. The following code will: use linked lists to be reasonably efficient, stop / resume your plot with a button, and have the data collected so far available on demand at any given time:
ClearAll[linkedList, toLinkedList, fromLinkedList, addToList, pop, emptyList];
SetAttributes[linkedList, HoldAllComplete];
toLinkedList[data_List] := Fold[linkedList, linkedList[], data];
fromLinkedList[ll_linkedList] := List ## Flatten[ll, Infinity, linkedList];
addToList[ll_, value_] := linkedList[ll, value];
pop[ll_] := Last#ll;
emptyList[] := linkedList[];
Clear[getData];
Module[{ll = emptyList[], time = 0, restart, plot, y},
getData[] := fromLinkedList[ll];
plot[] :=
Graphics[{Hue[0.67`, 0.6`, 0.6`], Line[fromLinkedList[ll]]},
AspectRatio -> 1/GoldenRatio, Axes -> True,
AxesLabel -> {"time", "angle"}, PlotRange -> {{0, 10}, {-Pi, Pi}},
PlotRangeClipping -> True];
DynamicModule[{sol, angle, llaux, delT = 0.1},
restart[] := (time = 0; llaux = emptyList[]);
llaux = ll;
sol := First#
NDSolve[{y''[t] + 0.1 y'[t] + Sin[y[t]] == 0, y[0] == Pi/4, y'[0] == 0},
y, {t, time, time + 1}];
angle := y /. sol;
ll := With[{res =
If[llaux === emptyList[] || pop[llaux][[1]] != time,
addToList[llaux, {time, angle[time]}],
(* else *)
llaux]},
llaux = res];
Column[{
Row[{Dynamic#delT, Slider[Dynamic[delT], {0.1, 1., 0.1}]}],
Dynamic[time, {None, Automatic, None}],
Row[{
Trigger[Dynamic[time], {0, 10, Dynamic#delT},
AppearanceElements -> { "PlayPauseButton"}],
Button[Style["Restart", Small], restart[]]
}],
Dynamic[plot[]]
}, Frame -> True]
]
]
Linked lists here replace your buffer and you don't need to pre-allocate and to know in advance how many data points you will have. The plot[] is a custom low-level plotting function, although we probably could just as well use ListPlot. You use the "Play" button to both stop and resume plotting, and you use the custom "Restart" button to reset the parameters.
You can call getData[] at any given time to get a list of data accumulated so far, like so:
In[218]:= getData[]
Out[218]= {{0,0.785398},{0.2,0.771383},{0.3,0.754062},{0.4,0.730105},{0.5,0.699755},
{0.6,0.663304},{0.7,0.621093},{0.8,0.573517},{0.9,0.521021},{1.,0.464099},
{1.1,0.403294},{1.2,0.339193},{1.3,0.272424}}
I just wonder why you want to solve the DE in pieces. It can be solved for the whole interval at once. There is also no need to place the NDSolve in the Manipulate then. It doesn't need to be solved time and again when the body of the Manipulateis triggered. Plot itself is sufficiently fast to plot the growing graph at each time step. The following code does what you want without the need for any storage.
sol = First#
NDSolve[{y''[t] + 0.1 y'[t] + Sin[y[t]]==0,y[0] == Pi/4,y'[0] == 0}, y, {t, 0, 10}];
eps = 0.000001;
Manipulate[
With[{angle = y /. sol},
Plot[angle[t], {t, 0, time + eps},
AxesLabel -> {"time", "angle"},
PlotRange -> {{0, max}, {-Pi, Pi}}
]
],
{{time, 0, "run"}, 0, max,Dynamic#delT, ControlType -> Trigger},
{{delT, 0.1, "delT"}, 0.1, 1, 0.1, Appearance -> "Labeled"}, TrackedSymbols :> {time},
Initialization :> (max = 10)
]
BTW: AppendTo may be vilified as slow, but it is not that slow. On a typical list suitable for plotting it takes less than a milisecond, so it shouldn't slow plotting at all.
Not memory efficient at all, but its virtue is that it only needs a slight modification of your first code:
Clear[tangle];
Manipulate[
sol = First#NDSolve[{y''[t] + 0.1 y'[t] + Sin[y[t]] == 0,
y[0] == Pi/4,
y'[0] == 0},
y, {t, time, time + 1}];
(tangle[time] = y /. sol;
ListPlot[Table[{j, tangle[j][j]}, {j, .1, max, delT}],
AxesLabel -> {"time", "angle"},
PlotRange -> {{0, max}, {-Pi, Pi}}]),
{{time, 0, "run"}, 0, max, Dynamic#delT, ControlType -> Trigger},
{{delT, 0.1, "delT"}, 0.1, 1, 0.1, Appearance -> "Labeled"},
TrackedSymbols :> {time},
Initialization :> {(max = 10); i = 0}]