Skip to main content

mesh - How to draw the shape of a 2D, 2nd order, element of an ElementMesh


I just want to create a drawing of the shape of 2nd order, two dimensional, finite element like a TriangleElement.



  • Something like mesh["Wireframe"] don't work because gives only a first order approximation of the mesh.

  • MeshRegion@ToElementMesh[...] don't work because gives some linear boundary instead of curved boundary.


  • Something like ToElementMesh@ToBoundaryMesh["Coordinates"->..., "BoundaryElements"->{LineElement[{{1,2,3},...}] don't work because... I don't know :)


I tried this:


Manipulate[Module[{mesh, g},
mesh = ToElementMesh["Coordinates" -> pts,
"MeshElements" -> {TriangleElement[{{1, 3, 5, 2, 4, 6}}]}];
g = RegionPlot[TrueQ@ElementMeshRegionMember[mesh, {x, y}],
Evaluate@Prepend[(Mean[#] - {-1.2, 1.2}/2*Subtract @@ # &)@MinMax@pts[[All, 1]], x],
Evaluate@Prepend[(Mean[#] - {-1.2, 1.2}/2*Subtract @@ # &)@MinMax@pts[[All, 2]], y],
Prolog -> {

PointSize[Large],
Red, Point@pts[[{1, 3, 5}]],
Blue, Point@pts[[{2, 4, 6}]]
},
PlotPoints -> 40, MaxRecursion -> 1,
ImageSize -> 300, Frame -> None, PlotRangePadding -> Scaled[.01],
Mesh -> Full,
PlotRange -> Full, PlotRangeClipping -> False,
PerformanceGoal -> "Quality"
]

],
{{pts, {{0, 0}, {4/7, -(1/39)}, {1, 1/4}, {7/15, 3/10}, {1/4, 2/3}, {-(1/39), 2/5}}},
Locator, LocatorAutoCreate -> False}
]

Mathematica graphics


but the result is unsatisfactory and too slow.


I hope to find a fast-enough way accurately represent a complete 2D 2nd order mesh.


Any idea?



Answer




Here is a way to do it. We use BezierCurve for the edges.


First we get the ordering of the egdes. And put the mid side node in the middle.


Needs["NDSolve`FEM`"]
triEdges = #[[{1, 3, 2}]] & /@
MeshElementBaseFaceIncidents[TriangleElement, 2];
quadEdges = #[[{1, 3, 2}]] & /@
MeshElementBaseFaceIncidents[QuadElement, 2];

This function gets us the edges of the elements:


ClearAll[getEdges]

getEdges[ele_TriangleElement] :=
Join @@ (ElementIncidents[ele][[All, #]] & /@ triEdges)
getEdges[ele_QuadElement] :=
Join @@ (ElementIncidents[ele][[All, #]] & /@ quadEdges)
getEdges[ele_List] := getEdges /@ ele

The next does the interpolation:


Clear[interpolatingQuadBezierCurve];
interpolatingQuadBezierCurve[pts_List] /; Length[pts] == 3 :=
BezierCurve[{pts[[1]], 1/2 (-pts[[1]] + 4 pts[[2]] - pts[[3]]),

pts[[3]]}];
interpolatingQuadBezierCurve[ptslist_List] :=
interpolatingQuadBezierCurve /@ ptslist;
interpolatingQuadBezierCurveComplex[coords_, indices_] :=
interpolatingQuadBezierCurve[Map[coords[[#]] &, indices]]

Try this with an example:


mesh = ToElementMesh[Disk[], "MaxCellMeasure" -> 1, 
PrecisionGoal -> 1];
Show[

mesh["Wireframe"["MeshElementStyle" -> EdgeForm[Green]]],
mesh["Wireframe"["MeshElement" -> "PointElements",
"MeshElementIDStyle" -> Blue,
"MeshElementStyle" -> Directive[PointSize[0.02], Red]]],
Graphics[{interpolatingQuadBezierCurveComplex[
mesh["Coordinates"], #] & /@
Join @@ getEdges[mesh["MeshElements"]]}]
]

Looks good:



enter image description here


Green is the linear mesh, black the second order mesh. Next, we try this with your mesh:


mesh = ToElementMesh[
"Coordinates" -> {{0, 0}, {1, 1/4}, {1/4,
2/3}, {4/7, -1/39}, {7/15, 3/10}, {-1/39, 2/5}},
"MeshElements" -> {TriangleElement[{{1, 2, 3, 4, 5, 6}}]}];
Show[
mesh["Wireframe"["MeshElementStyle" -> EdgeForm[Green]]],
mesh["Wireframe"["MeshElement" -> "PointElements",
"MeshElementIDStyle" -> Blue,

"MeshElementStyle" -> Directive[PointSize[0.02], Red]]],
Graphics[{interpolatingQuadBezierCurveComplex[
mesh["Coordinates"], #] & /@
Join @@ getEdges[mesh["MeshElements"]]}]
]

enter image description here


And here is the Manipulate


Manipulate[
Module[{mesh},

mesh = ToElementMesh["Coordinates" -> pts,
"MeshElements" -> {TriangleElement[{{1, 2, 3, 4, 5, 6}}]}];
Graphics[
MapThread[
interpolatingQuadBezierCurveComplex[mesh["Coordinates"], #] &,
getEdges[mesh["MeshElements"]]]
]
], {{pts, {{0, 0}, {1, 1/4}, {1/4, 2/3}, {4/7, -1/39}, {7/15,
3/10}, {-1/39, 2/5}}}, Locator, LocatorAutoCreate -> False}]


enter image description here


Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...

list manipulation - Selecting multiple columns from a matrix?

Sample data: data = { {{2013, 1, 1}, 24.13, 167.67, 231.82}, {{2013, 1, 2}, 32.15, 170.92, 225.99}, {{2013, 1, 3}, 35.43, 172.68, 221.67}, {{2013, 1, 4}, 36.73, 173.05, 218.32}, {{2013, 1, 5}, 58.19, 165.96, 197.05}, {{2013, 1, 6}, 69.99, 163.50, 187.52}, {{2013, 1, 7}, 71.37, 154.21, 175.58}, {{2013, 1, 8}, 72.51, 149.66, 163.25}}; I want a DateListPlot with three graphs, so for a matrix formed by columns 1 and 2, one for columns 1 and 3, and 1 for columns 1 and 4. At the moment I'm using this code: data2 = Transpose[{data[[All, 1]], data[[All, 2]]}]; data3 = Transpose[{data[[All, 1]], data[[All, 3]]}]; data4 = Transpose[{data[[All, 1]], data[[All, 4]]}]; DateListPlot[{data2, data3, data4}, Joined -> True, Filling -> {3 -> {1}}] but I have a hunch that this can be done more efficiently. I don't like the Transpose s in particular. Any ideas? edit (for extra credit) What if I need to multiply the second column by 2, which in my solution is simp...