Using loops to draw multiple polygons and discretizing them

Question

I am trying to plot the first eigenvalue of the Laplacian operator with zero Dirichlet condition on following figure against decreasing values of $\varepsilon$.

I used Polygon to create the first figure with $\varepsilon=0.9$:

r = Graphics[Polygon[{{0, 0}, {0, 1}, {1, 1}, {1, 0.9}, {2, 0.9}, {2, 1}, {3, 1}, {3, 0}, 
      {2, 0}, {2, 0.1}, {1, 0.1}, {1, 0}}]];

Then used DiscretizeGraphics to form the region:

dr = DiscretizeGraphics[r]

Using NDEigenSystem the Eigenvalue was obatined.

{vals, funs} = NDEigensystem[
   {-Laplacian[u[x, y], {x, y}], DirichletCondition[u[x, y] == 0, True]}, 
   u[x, y], {x, y} ∈ dr, 1, 
   Method -> 
     {"SpatialDiscretization" -> {"FiniteElement", 
         {"MeshOptions" -> {"MaxCellMeasure" -> 0.01}}}}
 ];

For few epsilons I can use the process described above by changing the polygon, and drawing a new region. Like:

Clear[r, dr, vals, funs];

r = Graphics[Polygon[{{0, 0}, {0, 1}, {1, 1}, {1, 0.8}, {2, 0.8}, {2, 1}, {3, 1}, {3, 0}, 
      {2, 0}, {2, 0.2}, {1, 0.2}, {1, 0}}]];
dr = DiscretizeGraphics[r]

{vals, funs} = NDEigensystem[
   {-Laplacian[u[x, y], {x, y}], DirichletCondition[u[x, y] == 0, True]},
   u[x, y], {x, y} ∈ dr, 1, 
   Method -> 
     {"SpatialDiscretization" -> {"FiniteElement", 
         {"MeshOptions" -> {"MaxCellMeasure" -> 0.01}}}}
  ];

list = Append[list, vals]
Flatten[%]

My question is, can this process by done within a loop?

Or is there in way to vary $\varepsilon$ without typing the above code block manually for different values of $\varepsilon$?

Answer 1

Once you have the NDEigensystems code in place, it is not difficult to extend it to work on multiple regions (this is, I believe, what @JM was nudging you towards).

For instance, generate a list of such polygons using Table:

r = Table[
  Graphics[
   Polygon[{
     {0, 0}, {0, 1}, {1, 1},
     {1, (1 + epsilon)/2}, {2, (1 + epsilon)/2}, {2, 1},
     {3, 1}, {3, 0}, {2, 0},
     {2, (1 - epsilon)/2}, {1, (1 - epsilon)/2}, {1, 0}}]
   ],
  {epsilon, 0.1, 0.9, 0.1}
 ]

Generate discretized regions them by mapping DiscretizeGraphics over the list:

dr = DiscretizeGraphics /@ r

Turn the call to NDEigensystem into a function that takes an integration region as a variable using pure functions (look up # and &), then collect your results in appropriately shaped lists vals and funs:

NDEigensystem[
    {-Laplacian[u[x, y], {x, y}], DirichletCondition[u[x, y] == 0, True]},
    u[x, y], {x, y} \[Element] #, 1,
    Method ->
     {"SpatialDiscretization" ->
       {"FiniteElement", {"MeshOptions" -> {"MaxCellMeasure" -> 0.01}}}
     }
   ] & /@ dr;

{vals, funs} = Transpose@%