0
$\begingroup$

I need to make a DensityPlot, a RegionPlot, and a ContourPlot of a function MinΔBG that I've defined in the code below, but my problem is:

the DensityPlot of the function shows after 15 minutes; however the computation runtime of the RegionPlot and ContourPlot of the same function are above 30 minutes in my laptop, and I stoped the processes after that time. Is there a better way to write the code below and so to optimize the runetime of the previous plots?

Here is my code:

SMValues := {g -> 0.64, g1 -> 0.34, yt -> 1.0, mh -> 125.18, vh -> 246.22}

ΔBGH[Λ_,mr_,λHR_] := Max[{(Λ^2 Abs[(3 g^2)/2+(9 g1^2)/2+(6 mh^2)/vh^2-12 yt^2-(3 mh^4)/(vh^2 (mh^2+Λ^2))+2 λHR-(2 mr^2 λHR)/(mr^2+Λ^2)])/(16 mh^2 π^2),(mr^2 Abs[λHR (-(Λ^2/(mr^2+Λ^2))+Log[1+Λ^2/mr^2])])/(8 mh^2 π^2),(λHR Abs[Λ^2-mr^2 Log[1+Λ^2/mr^2]])/(8 mh^2 π^2)}]
ΔBGR[Λ_,mr_,λHR_,λR_] := Max[{(Λ^2 Abs[(Λ^2 λHR)/(mh^2+Λ^2)+(6-(3 mr^2)/(mr^2+Λ^2)) λR])/(8 mr^2 π^2),(3 Abs[λR (-(Λ^2/(mr^2+Λ^2))+Log[1+Λ^2/mr^2])])/(8 π^2),(λHR Abs[Λ^2-mh^2 Log[1+Λ^2/mh^2]])/(8 mr^2 π^2),(3 λR Abs[-2 Λ^2+mr^2 Log[1+Λ^2/mr^2]])/(8 mr^2 π^2)}]

ΔBGHR[Λ_,mr_,λHR_,λR_] := Max[{ΔBGH[Λ,mr,λHR], ΔBGR[Λ,mr,λHR,λR]}]

MinΔBG[Λ_,λR_] := NMinValue[ΔBGHR[Λ,mr,λHR,λR], {mr,λHR} ∈ Rectangle[{50,-3},{65,-1.5}]]

DensityPlot[
  Evaluate[MinΔBG[Λ*10^3,λR]/.SMValues],{Λ,1,2},{λR,0,1},
  PlotLegends->BarLegend[Automatic],
  FrameLabel->{Style["Λ [TeV]",12,Bold], Style["λR",12,Bold]},
  Mesh->19,ColorFunction->"StarryNightColors"];

RegionPlot[Evaluate[MinΔBG[Λ*10^3,λR]/.SMList]<=10,{Λ,1,2},{λR,0,1}];

ContourPlot[Evaluate[MinΔBG[Λ*10^3,λR]/.SMList]==10,{Λ,1,2},{λR,0,1}];

Incidentally, when I evaluate the function MinΔBG[Λ,λR] for virtually any par of values (like in the following example), it yields the following message (error?):

MinΔBG[10^3, 0.4]/.SMValues
NMinValue::nnum: The function value Max[8.41802,-(36387.5/mh^2),616.062/mh^2,3.54321 Abs[2.39573 -2.93213*10^6/(1000000+mh^2)],(62500 Abs[-5.84337+(3 g^2)/2+(9 g1^2)/2+(6 mh^2)/vh^2-(3 mh^4)/((1000000+mh^2) vh^2)-12 yt^2])/(mh^2 π^2),-0.0000103891 Abs[1000000-mh^2 Log[1+1000000 Power[<<2>>]]]] is not a number at {mr,λHR} = {59.787,-2.93213}.
NMinValue::cvmit: Failed to converge to the requested accuracy or precision within 100 iterations.
7.11126

which I'm not sure it could be generating an increse in the running time of the plots.

I am working on Mathematica 12.0. My laptop is an HP Pavilion with intel i7 and 16 GB of ram.

$\endgroup$
1
$\begingroup$

This is a partial solution only.

g = 0.64; g1 = 0.34; yt = 1.0; mh = 125.18; vh = 246.22;

(* unchanged *)
ΔBGH[Λ_, mr_, λHR_] := Max[{(Λ^2 Abs[(3 g^2)/2 + (9 g1^2)/2 + (6 mh^2)/vh^2 - 12 yt^2 - (3 mh^4)/(vh^2 (mh^2 + Λ^2)) + 2 λHR - (2 mr^2 λHR)/(mr^2 + Λ^2)])/(16 mh^2 π^2), (mr^2 Abs[λHR (-(Λ^2/(mr^2 + Λ^2)) + Log[1 + Λ^2/mr^2])])/(8 mh^2 π^2), (λHR Abs[Λ^2 - mr^2 Log[1 + Λ^2/mr^2]])/(8 mh^2 π^2)}]
ΔBGR[Λ_, mr_, λHR_, λR_] := Max[{(Λ^2 Abs[(Λ^2 λHR)/(mh^2 + Λ^2) + (6 - (3 mr^2)/(mr^2 + Λ^2)) λR])/(8 mr^2 π^2), (3 Abs[λR (-(Λ^2/(mr^2 + Λ^2)) + Log[1 + Λ^2/mr^2])])/(8 π^2), (λHR Abs[Λ^2 - mh^2 Log[1 + Λ^2/mh^2]])/(8 mr^2 π^2), (3 λR Abs[-2 Λ^2 + mr^2 Log[1 + Λ^2/mr^2]])/(8 mr^2 π^2)}]
ΔBGHR[Λ_, mr_, λHR_, λR_] := Max[{ΔBGH[Λ, mr, λHR], ΔBGR[Λ, mr, λHR, λR]}]

(* added pattern `?NumericQ` to function arguments, 
   and changed the way the constraints are written *)
MinΔBG[Λ_?NumericQ, λR_?NumericQ] := NMinValue[{
   ΔBGHR[Λ, mr, λHR, λR],
   mr > 50 && mr < 65 && λHR > -3 && λHR < -1.5}, {mr, λHR}]

Calling MinΔBG with the example values now yields a number:

MinΔBG[10^3, 0.4]
  (* 7.11126 *)

DensityPlot and CountourPlot work (I used a small number for PlotPoints to make it faster).

DensityPlot[MinΔBG[Λ*10^3, λR], {Λ, 1, 2}, {λR, 0, 1}, 
 PlotLegends -> BarLegend[Automatic], FrameLabel -> {Style["Λ [TeV]", 12, Bold], 
   Style["λR", 12, Bold]}, Mesh -> 19, ColorFunction -> "StarryNightColors", PlotPoints -> 4]

enter image description here

ContourPlot[MinΔBG[Λ*10^3, λR] == 10, {Λ, 1, 2}, {λR, 0, 1}, PlotPoints -> 4]

enter image description here

I can't figure out what's wrong with RegionPlot - I'm getting errors like Break::nofwd: No enclosing For, While, or Do found for Break[].

$\endgroup$
  • $\begingroup$ Thanks you very much!, it's a highly improvement. $\endgroup$ – SNC92 Oct 7 '19 at 12:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.