How can I do a plot in real time as data is created?

Question

First, I have this two functions

fun1[x_] = Assuming[x > 0 && x ≤ 1, 0.5((Log[x/2])^2 - (ArcTanh[Sqrt[1 - x^2]])^2)]

and

fun2[x_] = Assuming[x > 1, 0.5((Log[x/2]^2 + (ArcTan[Sqrt[x^2 - 1]])^2)]

both function define a new piecewise function

funtot[x_] = Piecewise[{{fun1[x], x > 0 && x < 1}, {fun2[x], x > 1}}]

I need to define this last function because a I needed in this next numeric integral

F1[y_?NumericQ, w_?NumericQ, g_?NumericQ] := -I * w * Exp[0.5 * w * y^2] *
NIntegrate[x*(BesselJ[0, w * x * y])* Exp[I * w * (0.5 * x^2 - funtot[x] + 
0.0243401)],
{x, 0.001, g}, WorkingPrecision → 16, MaxRecursion → 30,
Method → {GlobalAdaptive, MaxErrorIncreases → 10 000}]

as you can see its a complex function, with "y", "w" and "g" parameters. Now with the next order can I create a table called tabreal1 with y = 0.1, g = 0.9999 and w runing on the interval (0.001,100) in steps size of 0.01

tabreal1 = Table[{w, Abs[F1[0.1, w, 0.9999]]}, {w, 0.001, 100, 0.01}]

Mathematica, as you can see in the next image, show me the table tabreal1 in this way because is too big (almost ten thousend couple values), and take almost like one hour

with the next algoritm, Mathematica take the table tabreal1 and plot that table in a LogLogPlot

NFW1b = ListLogLogPlot[tabreal1, Frame->True, PlotRange->{{0.001, 100}, 
{.25, 10}},
AspectRatio->1, ImageSize->Large, FrameTicks->All,
GridLines->Automatic, PlotStyle->Black, PlotMarkers->{Automatic, 2}]

seconds later, this is the plot

There is some way to create that plot in real time as the table tabreal1 is created? thats it, as Mathematica found some $(w_{1},F1_{1})$ Mathematica puts it immediately in the graph and I can see it, and seconds later when Mathematica found another $(w_{2},F1_{2})$ value Mathematica put in the graph and so on...

I need to require this because I need to make the step size of w smaller, actually with the step size of 0.001 the time taken to do tabreal1 was almost ten hours, I guess with the visual aspect as the graph is crated can figure how time is remaining.

According to Wolfram Documentation center, the command Dynamic can help me to do this, but not work at all.

Thanks in advance for any help.

Answer 1

Here is a simplified example. The function slowfun below is intentionally slow, to stand in for your long calculation.

ClearAll[slowfun]
slowfun[x_] := (Pause[1]; x^2)

Dynamic[ListLinePlot[
  table,
  PlotRange -> {{-10, 10}, {0, 100}}, PlotRangePadding -> Scaled[0.1],
  Mesh -> All, MeshStyle -> Red]
]

table = {}; x = -10;
While[x <= 10,
  table = AppendTo[table, {x, slowfun[x]}];
  x++
]

Answer 2

By constructing a table of points by hand with even spacing throughout, you waste a lot of time on regions of the function that are essentially flat. When possible, it is often good to take advantage of the excellent adaptive methods available internally to the Plot functions, which will sample the function more thoroughly only were needed.

Here is your code, slightly refactored:

Clear[F1, funtot]

funtot[x_] = Piecewise[{
    {0.5 Log[x/2]^2 - ArcTanh[Sqrt[1 - x^2]]^2, 0 < x < 1},
    {0.5 Log[x/2]^2 + ArcTan[Sqrt[x^2 - 1]]^2, x > 1}}];

F1[y_?NumericQ, w_?NumericQ, g_?NumericQ] :=
 -I w Exp[0.5 w y^2] NIntegrate[
   x BesselJ[0, w x y] Exp[I w (0.5 x^2 - funtot[x] + 0.0243401)], {x,0.001, g}]

plot = 
  LogLogPlot[
     Abs@F1[0.1, w, .9999], {w, 0.1, 100},
     Frame -> True, PlotRange -> {{0.001, 100}, {.1, 2}},
     AspectRatio -> 1, ImageSize -> Large, FrameTicks -> All,
     GridLines -> Automatic, PlotStyle -> Black,
     Exclusions -> None
  ]

In particular, I removed your request for higher working precision, which seemed ineffective, since many function arguments were given at machine precision (e.g. 0.5, etc). I also let NIntegrate automatically select a method as a first attempt; since the automatic method seemed to work fine, I did not modify it further.

Timing using AbsoluteTiming@LogLogPlot[...] shows it only took 27 seconds to generate the plot above, instead of hours. Plot did not spend much time in those regions where the function is essentially a straight line, but concentrated its efforts in regions of high curvature. Here are the points that were actually sampled:

plot /. Line[l_] :> Through[{{Red, PointSize[0.015], Point[#]} &, Line}[l]]

Answer 3

Monitor works reasonably well for that.

fun1[x_] = Assuming[x > 0 && x <= 1, 0.5 (Log[x/2]^2 - ArcTanh[Sqrt[1 - x^2]]^2)]
fun2[x_] =  Assuming[x > 1, 0.5 (Log[x/2]^2 + (ArcTan[Sqrt[x^2 - 1]])^2)]
funtot[x_] = Piecewise[{{fun1[x], x > 0 && x < 1}, {fun2[x], x > 1}}]
F1[y_?NumericQ, w_?NumericQ, g_?NumericQ] :=
 -I*w*Exp[0.5*w*y^2]*NIntegrate[
   x*(BesselJ[0, w*x*y])*Exp[I*w*(0.5*x^2 - funtot[x] + 0.0243401)], {x, 0.001, g}
  ]

tabreal1 = {};
Monitor[
 For[w = .001, w <= 100, w += .01, AppendTo[tabreal1, {w, Abs[F1[0.1, w, 0.9999]]}]], 
 ListLogLogPlot[tabreal1, 
  Frame -> True, PlotRange -> {{0.001, 100}, {.25, 10}}, AspectRatio -> 1,
  ImageSize -> Large, FrameTicks -> All, GridLines -> Automatic, PlotStyle -> Black,
  PlotMarkers -> {Automatic, 2}
 ]
]

I've removed your WorkingPrecision and Method options as they resulted in

 NIntegrate::ilim: Invalid integration variable or limit(s) 

kind of errors in my case (11.0 on Windows 10). The result still looks identical to yours, at least in the range you plotted it.