Issues finding the minimum of a function over an implicit domain

Question

i am new to mathematica and am really having some problems when finding the minimum of a function over a implicitly defined domain.

This is my code:

Inertia[r_,t_]:= (Pi/4)*(r^4 - (r-t)^4)
Mass[r_,t_]:= (Pi)*(r^2 - (r-t)^2)*7850

This is an example of what i want to produce:

minI = 11320*^-12;
minT = 2*^-3;
reg = ImplicitRegion[{Inertia[r,t]>=minI, 0<r<20*^-3,minT<t<(r-minT)},{r,t}];
RegionPlot[reg]

minM = Minimize[Mass[r,t],{r,t} \[Element] reg]
p1 = Plot3D[Mass[r,t],{r,t} \[Element] reg];
p2 = ListPointPlot3D[{{r,t,Mass[r,t]}}/.minM[[2]],PlotStyle->Red];
Show[p1,p2,PlotRange->All]

However by just changing the value of MinI and minT I get a completely different result which isn't what i want, despite the code being identical:

minI = 8509*^-12;
minT = 1.2*^-3;
reg2 = ImplicitRegion[{Inertia[r,t]>=minI, 0<r<20*^-3,minT<t<(r-minT)},{r,t}];
RegionPlot[reg2]

minM = Minimize[Mass[r,t],{r,t} \[Element] reg2]
p1 = Plot3D[Mass[r,t],{r,t} \[Element] reg2];
p2 = ListPointPlot3D[{{r,t,Mass[r,t]}}/.minM[[2]],PlotStyle->Red];
Show[p1,p2,PlotRange->All]

Output: {0.106459, {r -> 0.00239861, t -> 0.00120006}}

It looks to me that despite the code being identical, this is solving over the wrong domain all of a sudden. The reason i think this might be the case is because the results are practically identical when i try this:

reg3 = ImplicitRegion[{0<r<20*^-3,minT<t<(r-minT)},{r,t}];
RegionPlot[reg3]

minM2 = Minimize[Mass[r,t],{r,t} \[Element] reg3]
p1 = Plot3D[Mass[r,t],{r,t} \[Element] reg3];
p2 = ListPointPlot3D[{{r,t,Mass[r,t]}}/.minM2[[2]],PlotStyle->Red];
Show[p1,p2,PlotRange->All]

Output: {0.106541, {r -> 0.00240005, t -> 0.00120002}}

I tried discretising the region and that doesn't produce the result i want either:

reg3 = BoundaryDiscretizeRegion[reg2,MaxCellMeasure->0.0001];
RegionPlot[reg3]

minM = Minimize[Mass[r,t],{r,t} \[Element] reg3]
p1 = Plot3D[Mass[r,t],{r,t} \[Element] reg3];
p2 = ListPointPlot3D[{{r,t,Mass[r,t]}}/.minM[[2]],PlotStyle->Red];
Show[p1,p2,PlotRange->All]

the position of the point marked is now within the domain i want, but from visual inspection clearly not at the minimum.

Any advice would really be appreciated.

Answer 1

$Version

(* "14.0.0 for Mac OS X ARM (64-bit) (December 13, 2023)" *)

Clear["Global`*"]

Inertia[r_, t_] := (Pi/4)*(r^4 - (r - t)^4)
Mass[r_, t_] := Pi*(r^2 - (r - t)^2)*7850

minI = 11320*^-12;
minT = 2*^-3;
reg = ImplicitRegion[{Inertia[r, t] >= minI, 0 < r < 20*^-3, 
    minT < t < (r - minT)}, {r, t}];

minM = Minimize[Mass[r, t], {r, t} ∈ reg] // Quiet
minM // N

p1 = Plot3D[Mass[r, t], {r, t} ∈ reg,
   PlotStyle -> Opacity[0],
   BoundaryStyle -> {Thick, ColorData[97][1]},
   Mesh -> None];
p2 = ListPointPlot3D[{Tooltip[{r, t, Mass[r, t]}]} /. minM[[2]], 
   PlotStyle -> Directive[AbsolutePointSize[6], Red]];

minI2 = 8509*^-12;
minT2 = 12*^-4;
reg2 = ImplicitRegion[{Inertia[r, t] >= minI2, 0 < r < 20*^-3, 
    minT2 < t < (r - minT2)}, {r, t}];

minM2 = Minimize[Mass[r, t], {r, t} ∈ reg2] // Quiet
minM2 // N

p3 = Plot3D[Mass[r, t], {r, t} ∈ reg2,
   PlotStyle -> Opacity[0.5]];
p4 = ListPointPlot3D[{Tooltip[{r, t, Mass[r, t]}]} /. minM2[[2]], 
   PlotStyle -> Directive[AbsolutePointSize[6], Red]];

RegionPlot[{reg, reg2}, 
 PlotLegends -> Placed[{"reg", "reg2"}, {.2, .8}]]

Show[p1, p2, p3, p4, PlotRange -> All]