Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Graphic not showing on some occasions #130

Open
stepelu opened this issue Apr 18, 2022 · 1 comment
Open

Graphic not showing on some occasions #130

stepelu opened this issue Apr 18, 2022 · 1 comment

Comments

@stepelu
Copy link

stepelu commented Apr 18, 2022

Consider the following code:

Options@FindRoots = Sort@Join[Options@FindRoot, {MaxRecursion -> Automatic, PerformanceGoal :> $PerformanceGoal, PlotPoints -> Automatic, Debug -> False, ZeroTolerance -> 10^-2}];

FindRoots[fun_, {var_, min_, max_}, opts:OptionsPattern[]] := Module[{PlotRules, RootRules, g, g2, pts, pts2, lpts, F, sol},
    (* Extract the Options *)
    PlotRules = Sequence @@ FilterRules[Join[{opts}, Options@FindRoots], Options@Plot];
    RootRules = Sequence @@ FilterRules[Join[{opts}, Options@FindRoots], Options@FindRoot];

    (* Plot the function and "mesh" the point with y-coordinate 0 *)
    g = Normal@Plot[fun, {var, min, max}, MeshFunctions -> (#2 &), Mesh -> {{0}}, Method -> Automatic, Evaluate@PlotRules];

    (* Get the meshes zeros *)
    pts = Cases[g, Point[p_] :> SetPrecision[p[[1]], OptionValue@WorkingPrecision], Infinity];
    (* Get all plot points *)
    lpts = Join@@Cases[g, Line[p_] :> SetPrecision[p, OptionValue@WorkingPrecision], Infinity];

    (* Derive the interpolated data to find other zeros *)
    F = Interpolation[lpts, InterpolationOrder->2];
    g2 = Normal@Plot[Evaluate@D[F@var, var], {var, min, max}, MeshFunctions -> (#2 &), Mesh -> {{0}}, Method -> Automatic, Evaluate@PlotRules];

    (* Get the meshes zeros and retain only small ones *)
    pts2 = Cases[g2, Point[p_] :> SetPrecision[p[[1]], OptionValue@WorkingPrecision], Infinity];
    pts2 = Select[pts2, Abs[F@#] < OptionValue@ZeroTolerance &];
    pts = Join[pts, pts2]; (* Join all zeros *)

    (* Refine zeros by passing each point through FindRoot *)
    If[Length@pts > 0,
       pts = Map[FindRoot[fun, {var, #}, Evaluate@RootRules]&, pts];
       sol = Union@Select[pts, min <= Last@Last@# <= max &];
       (* For debug purposes *)
       If[OptionValue@Debug, Print@Show[g, Graphics@{PointSize@0.02, Red, Point[{var, fun} /. sol]}]];
       sol
    ,
       If[OptionValue@Debug, Print@g];
       {}
    ]
]

f[x_?NumericQ] := Abs[x] Sin[Abs@x]^2
count = FindRoots[f[x*2], {x, -10, 10}
   , Debug -> True
   , ImageSize -> 300] // Quiet
Length[count]

Using this kernel (via wolframscript) fails to produce the desired graphical output, I just get -Graphics-:
image

On Wolfram Cloud the plot is correctly displayed:
image

Is this a known issue?

@kinchahoy
Copy link

I have the same issue in a different context. If I export the graph to PNG it works, so there has to be someway to get Jupyiter to show it.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

2 participants