8
$\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$
  • $\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 '16 at 11:52
  • $\begingroup$ Why do you need the circle in the mesh? $\endgroup$ – Chip Hurst Sep 22 '16 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 '16 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 '16 at 8:36
  • $\begingroup$ It will be helpful if you post the code you tried.. $\endgroup$ – halmir Sep 23 '16 at 13:03
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["http://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$
  • $\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$ – Zhao Jul 23 '19 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$ – Zhao Jul 23 '19 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 '19 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, privacy policy and cookie policy

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