3
$\begingroup$

Let us first define a two regions as follow :

inner=1;outer=2;
reg1 = Disk[{0, 0}, inner];
reg2 = Annulus[{0, 0}, {inner, outer}];
glass=1.5;air=1;

Now let's say I want to assign different values for a particular parameter(say refractive index) to the two different regions (say 1 for the region "reg1" and 2 for the region "reg2".I can do it as follow .Here I have also smoothened the piecewise function.

appro = With[{k = 100}, ArcTan[k #]/Pi + 1/2 &];
ref[x_, y_] = Simplify`PWToUnitStep@PiecewiseExpand@If[x^2+y^2<=inner^2, glass, air] /.UnitStep -> appro ;  

It returns the result as follow

ref[1.1, 0]
(*1.0167*)

Now in this case doing the smoothening is pretty easy because I can write the mathematical form of the interface between the two regions easily.But for a complicated regions this is not so easy.So I can do the following thing.

ref[x_, y_] = Simplify`PWToUnitStep@ PiecewiseExpand@If[RegionMember[reg1, {x, y}], glass, air] /.  UnitStep -> appro ; 

This returns the result as follow

ref[1.1, 0]
(*1.000*)

So this can't do the smoothening thing here.Can someone help me in figure out this thing where I can do the smoothening for complicated regions?

$\endgroup$
0
$\begingroup$

PiecewiseExpand owns a second argument:

ref[x_, y_] = 
 Simplify`PWToUnitStep@
   PiecewiseExpand[If[RegionMember[reg1, {x, y}], glass, air], Reals] /.  
  UnitStep -> appro
(* 1 + 0.5 (1/2 + ArcTan[100 (1 - x^2 - y^2)]/π) *)
$\endgroup$
1
  • $\begingroup$ thank you so much @xzczd $\endgroup$ – krishnendu maji Dec 27 '20 at 10:36
2
$\begingroup$

Relate link : Smooth Boxcar function (Rectangle Pulse function)

Here we also use mollifier (https://en.wikipedia.org/wiki/Mollifier) just a test,not so effect.

We chose a ParametricRegion reg1 which can replace to other ImplicitRegion etc. We can also adjust $\epsilon=10^-8$ to other small positive real number.

φ[x_, y_] = 
  Piecewise[{{Exp[-1/(1 - (x^2 + y^2))], x^2 + y^2 < 1}}];
const = NIntegrate[φ[x, 
    y], {x, -∞, ∞}, {y, -∞,∞}];
k[x_, y_, ϵ_ /; ϵ > 0] = 
  1/ϵ^2 φ[x/ϵ, y/ϵ]/const;
mollify[f_][ϵ_ /; ϵ > 0][x_, y_] := 
  NIntegrate[
   f[x - u, y - v] k[u, v, ϵ]*
    Boole[u^2 +v^2 < ϵ^2], {u, -ϵ, ϵ}, {v, -ϵ, ϵ}, Method -> "LocalAdaptive"];
reg1 = ParametricRegion[{{s, (1 + t) s^2 - t}, -1 <= s <= 1 && 
     0 <= t <= 1}, {s, t}];
f[x_, y_] = Piecewise[{{1.5, {x, y} ∈ reg1}}, 1];
pts = {{.1, .2}, {1, 1}, {0, 0}, {0, 10^-9}, {0, -0.2}};
DensityPlot[f[x, y], {x, -2, 2}, {y, -2, 2}, PlotPoints -> 50, 
 MaxRecursion -> 6, Epilog -> {Red, Point[pts]}]
mollify[f][10^-8] @@@ pts

{1., 1.01443, 1.25, 1.20265, 1.5}

enter image description here

$\endgroup$
1
  • $\begingroup$ thanks for the answer.But I think this method is not so efficient as Simplify`PWToUnitStep..and takes a good amount of time. $\endgroup$ – krishnendu maji Dec 27 '20 at 5:37

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.