9
$\begingroup$

It is probably a stupid question, but I can't figure out how to generate a mesh from picture like this

Graphics[{{EdgeForm[Thin], FaceForm[LightGray], 
   Rectangle[{-3, -2}, {3, 2}]}, {Circle[{0, 0}, 1.]}, {EdgeForm[
    Thin], FaceForm[White], Disk[{0, 0}, .5]}}]

enter image description here

where the white disk is actually a hole. The circle disappeared in all my attempts.

$\endgroup$
5
  • $\begingroup$ Not sure whether I fully understand, do you want to mesh the grey annulus (between radius 0.5 and 1) separately from the rest of the rectangle? If so then using DiscretizeRegion together with ImplicitRegion could be useful i.e.: mesh1 = DiscretizeRegion[ ImplicitRegion[((-3 <= x <= 3) && (-2 <= y <= 2) && (x^2 + y^2 >= 1)), {x, y}] ]; mesh2 = DiscretizeRegion[ ImplicitRegion[((x^2 + y^2 >= 0.5) && (x^2 + y^2 <= 1)), {x, y}] ]; Show[{mesh1, mesh2}] $\endgroup$
    – Dunlop
    Sep 22, 2016 at 11:52
  • $\begingroup$ Why do you need the circle in the mesh? $\endgroup$
    – Greg Hurst
    Sep 22, 2016 at 14:17
  • $\begingroup$ I don't see that any of mathematicas built in mesh generation ( DiscretizeRegion or ToElementMesh ) has capability to create a single mesh with such an internal edge. There certainly are reasons to do that of course. $\endgroup$
    – george2079
    Sep 22, 2016 at 19:27
  • $\begingroup$ I want to have one mesh with a circle which separates two regions of different properties. I've eventually found a solution using ToElementMesh and "BoundaryMeshGenerator" -> {"Continuation"} and "RegionHoles" properties. But it's rather tricky, I still would like to have a more straightforward solution. $\endgroup$
    – T. Rihacek
    Sep 23, 2016 at 8:36
  • $\begingroup$ It will be helpful if you post the code you tried.. $\endgroup$
    – halmir
    Sep 23, 2016 at 13:03

3 Answers 3

12
$\begingroup$

I think this is a good question. Here's an example showing what I believe is the desired result, but using a laborious method specifying the boundary coordinates and line elements explicitly.

Needs["NDSolve`FEM`"]

rectanglepoints = {{-3, -2}, {-3, 2}, {3, 2}, {3, -2}};
circlepoints = CirclePoints[1, 30];
holepoints = CirclePoints[0.5, 30];

bm = ToBoundaryMesh[
      "Coordinates" -> Join[rectanglepoints, circlepoints, holepoints],
      "BoundaryElements" -> {
     LineElement[{{1, 2}, {2, 3}, {3, 4}, {4, 1}}], 
     LineElement[Partition[4 + Range[1, 30], 2, 1, {1, 1}]],
     LineElement[Partition[34 + Range[1, 30], 2, 1, {1, 1}]]}];

em = ToElementMesh[bm, "RegionHoles" -> {0, 0}, "RegionMarker" -> {{0, 0.75}, 1}];

em["Wireframe"["MeshElementStyle" -> {FaceForm[Green], FaceForm[Red]}]]

enter image description here

There must surely be a better way, to generate the mesh from Rectangle and Annulus regions.

$\endgroup$
7
$\begingroup$

I once helped someone with something similar from a micrograph.

img = Import["https://i.stack.imgur.com/B8B1D.jpg"];

cleaned = Thinning@ColorNegate@Binarize[img, 0.7];
imgComp = MorphologicalComponents[cleaned];
imgComp // Colorize

Mathematica graphics

SortBy[Tally[Flatten[imgComp]], Last]
{innerCircle, outerCircle, bdyRect, backgroundComp} = %[[All, 1]]
(*
  {{3, 163}, {2, 325}, {1, 1146}, {0, 86566}}
  {3, 2, 1, 0}
*)

outerPos = N@PixelValuePositions[Image@imgComp, outerCircle];
innerPos = N@PixelValuePositions[Image@imgComp, innerCircle];
bdyPos = N@PixelValuePositions[Image@imgComp, bdyRect];

I down-sample the circles, which is optional (see the mesh visualization below to adjust as needed).

outer = SortBy[outerPos, ArcTan @@ (# - Mean[outerPos]) &][[;; ;; 5]];
inner = SortBy[innerPos, ArcTan @@ (# - Mean[innerPos]) &][[;; ;; 5]];

Length /@ {outer, inner}
(*  {65, 33, 1146}  *)

corners = ImageCorners@Image[imgComp /. x_ /; x > 1 -> 0]
(*  {{350.5, 9.5}, {350.5, 235.5}, {9.5, 235.5}, {9.5, 9.5}}  *)

Needs["NDSolve`FEM`"]

bmesh = ToBoundaryMesh["Coordinates" -> Join[outer, inner, corners],
    "BoundaryElements" -> {LineElement[
      Partition[Append[Range[Length@outer], 1], 2, 1, 1]], 
     LineElement[
      Partition[Append[Length@outer + Range[Length@inner], Length@outer + 1], 
       2, 1, 1]],
     LineElement[
      Partition[Append[Length@outer + Length@inner + Range[Length@corners], 
                 Length@outer + Length@inner + 1],
       2, 1, 1]]}];

mesh = ToElementMesh[bmesh,
  "RegionHoles" -> Mean /@ {MinMax@corners[[All, 1]], MinMax@corners[[All, 2]]}
  ];

Show[
 mesh["Wireframe"],
 mesh["Wireframe"["MeshElement" -> "BoundaryElements", "MeshElementStyle" -> Red]]
 ]

Mathematica graphics

Without down-sampling:

Mathematica graphics

$\endgroup$
3
  • $\begingroup$ Sorry for necroing. If my micrograph was more complicated (multiple islands etc.) would I still be able to mesh it using the same way you have done here? $\endgroup$
    – Letshin
    Jul 23, 2019 at 11:22
  • $\begingroup$ To clarify the main issue I am having (I think) is that the perimeter coordinates I am getting from MorphologicalPerimeter is not sorted correctly - it is discretised over the X axis rather than by connected points. Should I make a new question for this? $\endgroup$
    – Letshin
    Jul 23, 2019 at 12:38
  • $\begingroup$ @Zhao It's probably better to ask a new question. I don't have any general advice based on your description, plus there are others on this site who are much more experienced with image processing than I am. $\endgroup$
    – Michael E2
    Jul 23, 2019 at 15:41
5
$\begingroup$

I am still not sure what is the expected output. But you could try ImageMesh function:

picture = 
 Graphics[{{Thickness[.005], Circle[{0, 0}, 1.]}, Disk[{0, 0}, .5]}, 
  PlotRange -> {{-3, 3}, {-2, 2}}]

enter image description here

ImageMesh[picture, Method -> "MarchingSquares"]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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