3
$\begingroup$

I am attempting to illustrate a mapping from an isoparametric space to a parent (x-y) space for a variety of finite element types. Here we consider the simplest case of a three noded triangular element. In the isoparametric space the triangle has nodes at {{1,0},{0,1},{0,1}} with interpolating functions n1=\xi n2=\eta n3=1-\xi-\eta. The isoparametric space maps to the parent space by

x=N1*x1=N2*x2+N3*x3, and y=N1*y1+N2*y2+N3*y3

Where xi is the x coordinate of the i-th node.

I am currently plotting this with the following code:

Step 1: Define interpolating functions and nodal positions in the isoparametric and parent spaces

n1lintri[x_, y_] := x
n2lintri[x_, y_] := y
n3lintri[x_, y_] := 1 - x - y

xltar = 1; yltar = 0;
xltbr = 0; yltbr = 1;
xltcr = 0; yltcr = 0;

xlta = 4; ylta = 3;
xltb = 1; yltb = 2;
xltc = 3; yltc = 1;

Step 2: Define domain to plot over

domain = Region[Triangle[{{0, 0}, {1, 0}, {0, 1}}]];

Step 3: Create parametric plot of isoparametric and parent domains and list of nodal points

lintri1 = 
  ParametricPlot[{ 
    xltar n1lintri[x, y] + xltbr n2lintri[x, y] + 
     xltcr n3lintri[x, y], 
    yltar n1lintri[x, y] + yltbr n2lintri[x, y] + 
     yltcr n3lintri[x, y]}, {x, y} \[Element] domain, Frame -> False, 
   Axes -> False];
lintri1points = {{xltar, yltar}, {xltbr, yltbr}, {xltcr, yltcr}};

lintri2 = 
  ParametricPlot[{ 
    xlta n1lintri[x, y] + xltb n2lintri[x, y] + xltc n3lintri[x, y], 
    ylta n1lintri[x, y] + yltb n2lintri[x, y] + 
     yltc n3lintri[x, y]}, {x, y} \[Element] domain, Frame -> False];
lintri2points = {{xlta, ylta}, {xltb, yltb}, {xltc, yltc}};

Step 4: Plot

Labeled[Show[lintri1, 
  ListPlot[lintri1points, PlotStyle -> {Red, PointSize[Large]}, 
   Frame -> False], Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> All], {Style["\[Xi]", 18, Black, Bold], 
  Style["\[Eta]", 18, Black, Bold]}, {Bottom, Left}]
Labeled[Show[lintri2, 
  ListPlot[lintri2points, PlotStyle -> {Red, PointSize[Large]}, 
   Frame -> False], Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> All], {Style["x", 18, Black, Bold], 
  Style["y", 18, Black, Bold]}, {Bottom, Left}]

Which yields the following

enter image description here

I would like to add labels numbering each node (in red) numbered sequentially with an offset so that the number is not on top of the node. For example

enter image description here

As elements can have many nodes I would prefer to not manually prescribe to offset for each label.

For a higher order element the corresponding code would be

Step 1: 

n1quadtri[x_, y_] := x (2 x - 1)
n2quadtri[x_, y_] := y (2 y - 1)
n3quadtri[x_, y_] := (1 - x - y) (2 (1 - x - y) - 1)
n4quadtri[x_, y_] := 4 x y
n5quadtri[x_, y_] := 4 y (1 - x - y)
n6quadtri[x_, y_] := 4 (1 - x - y) x
xqtar = 1; yqtar = 0;
xqtbr = 0; yqtbr = 1;
xqtcr = 0; yqtcr = 0;
xqtdr = 0.5; yqtdr = 0.5;
xqter = 0; yqter = 0.5;
xqtfr = 0.5; yqtfr = 0;

xqta = 1; yqta = 0;
xqtb = 0; yqtb = 1;
xqtc = 0; yqtc = 0;
xqtd = 0.75; yqtd = 0.75;
xqte = 0.25; yqte = 0.5;
xqtf = 0.5; yqtf = 0;

Step 2:

domain = Region[Triangle[{{0, 0}, {1, 0}, {0, 1}}]];

Step 3: 

quadtri1 = 
  ParametricPlot[{ 
    xqtar n1quadtri[x, y] + xqtbr n2quadtri[x, y] + 
     xqtcr n3quadtri[x, y] + xqtdr n4quadtri[x, y] + 
     xqter n5quadtri[x, y] + xqtfr n6quadtri[x, y], 
    yqtar n1quadtri[x, y] + yqtbr n2quadtri[x, y] + 
     yqtcr n3quadtri[x, y] + yqtdr n4quadtri[x, y] + 
     yqter n5quadtri[x, y] + yqtfr n6quadtri[x, y]}, {x, 
     y} \[Element] domain, Frame -> False, Axes -> False];
quadtri1points = {{xqtar, yqtar}, {xqtbr, yqtbr}, {xqtcr, 
    yqtcr}, {xqtdr, yqtdr}, {xqter, yqter}, {xqtfr, yqtfr}};

quadtri2 = 
  ParametricPlot[{ 
    xqta n1quadtri[x, y] + xqtb n2quadtri[x, y] + 
     xqtc n3quadtri[x, y] + xqtd n4quadtri[x, y] + 
     xqte n5quadtri[x, y] + xqtf n6quadtri[x, y], 
    yqta n1quadtri[x, y] + yqtb n2quadtri[x, y] + 
     yqtc n3quadtri[x, y] + yqtd n4quadtri[x, y] + 
     yqte n5quadtri[x, y] + yqtf n6quadtri[x, y]}, {x, y} \[Element] 
    domain, Frame -> False, Axes -> False];
quadtri2points = {{xqta, yqta}, {xqtb, yqtb}, {xqtc, yqtc}, {xqtd, 
    yqtd}, {xqte, yqte}, {xqtf, yqtf}};

Step 4:

Labeled[Show[quadtri1, 
  ListPlot[quadtri1points, PlotStyle -> {Red, PointSize[Large]}, 
   Frame -> False], Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> All], {Style["\[Xi]", 18, Black, Bold], 
  Style["\[Eta]", 18, Black, Bold]}, {Bottom, Left}]
Labeled[Show[quadtri2, 
  ListPlot[quadtri2points, PlotStyle -> {Red, PointSize[Large]}, 
   Frame -> False], Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> All], {Style["x", 18, Black, Bold], 
  Style["y", 18, Black, Bold]}, {Bottom, Left}]

Which yields

enter image description here

Which would ideally be labelled as

enter image description here

Any help would be appreciated.

Improve this question
$\endgroup$
4
  • $\begingroup$ Would you kindly provide an example of how exactly you want the points labeled? While it is clear how you wish to have the outcome of the automated offset, the actual labeling you wish you have is not clear to me. Thank you. $\endgroup$
    – CA Trevillian
    May 8, 2020 at 9:08
  • 1
    $\begingroup$ @CATrevillian I have updated the question to make this clearer, hopefully it helps! $\endgroup$
    – DvanHuyssteen
    May 8, 2020 at 9:33
  • $\begingroup$ Most definitely! Last clarification on the desires for this question, regarding your use of Axes versus a 2-sided Frame--is there a reason for axes as opposed to a frame? And should the labels be placed within the axes/frame, or outside of the defined region? Which takes precedent? kglr provides a nice answer below which you can likely modify to sate your needs. $\endgroup$
    – CA Trevillian
    May 8, 2020 at 10:12
  • $\begingroup$ @CATrevillian For consistency with other figures I've made I'd prefer to have Axes instead of a Frame. Ideally I would like all labels (point labels and axis labels) to be in the defined region. $\endgroup$
    – DvanHuyssteen
    May 8, 2020 at 10:22

2 Answers 2

Reset to default
4
$\begingroup$ 
ClearAll[labeledPoints]
labeledPoints[off_: .05] := Module[{rc = RegionCentroid[ConvexHullMesh @ #]}, 
  {MapIndexed[Text[#2[[1]], # + off Normalize[# - rc]] &, #],
   Red, PointSize[Large], Point @ #}] &;

Examples:

Labeled[Show[lintri1, Epilog -> labeledPoints[][lintri1points], 
  Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> All], {Style["ξ", 18, Black, Bold], 
  Style["η", 18, Black, Bold]}, {Bottom, Left}]

enter image description here

Labeled[Show[lintri2, Epilog -> labeledPoints[.15][lintri2points], 
  Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> All], {Style["x", 18, Black, Bold], 
  Style["y", 18, Black, Bold]}, {Bottom, Left}]

enter image description here

Labeled[Show[quadtri1, Epilog -> labeledPoints[][quadtri1points], 
  Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> All], {Style["ξ", 18, Black, Bold], 
  Style["η", 18, Black, Bold]}, {Bottom, Left}]

enter image description here

Labeled[Show[quadtri2, Epilog -> labeledPoints[][quadtri2points], 
  Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> All], {Style["x", 18, Black, Bold], 
  Style["y", 18, Black, Bold]}, {Bottom, Left}]

enter image description here

Use negative values for the offset parameter to place the labels inside. For example,

Labeled[Show[quadtri1, Epilog -> labeledPoints[-.05][quadtri1points], 
  Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> All], {Style["ξ", 18, Black, Bold], 
  Style["η", 18, Black, Bold]}, {Bottom, Left}]

enter image description here

Labeled[Show[quadtri2, Epilog -> labeledPoints[-.05][quadtri2points], 
  Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> All], {Style["x", 18, Black, Bold], 
  Style["y", 18, Black, Bold]}, {Bottom, Left}]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ This solution works really nicely! I wonder, is there a way to change the font size and font color of the node labels? And while it was not part of the original question, is it possible to include the axis labels in the image region? Currently using 'right click' and 'save as' does not include the axis labels in the saved image. $\endgroup$
    – DvanHuyssteen
    May 8, 2020 at 11:16
  • 1
    $\begingroup$ @DvanHuyssteen, you can change Text[#2[[1]],...] to Text[Style[#2[[1]], 6, Blue],..] to make the label font size 16 and color Blue. For the axes label issue, you can try Show[..., Frame->{{True, False}{, {True, False}},FrameLabels->{{Style["y", 18, Black, Bold], None},{ Style["y", 18, Black, Bold], None}}] instead of Labeled[Show[...], ..]. $\endgroup$
    – kglr
    May 8, 2020 at 11:28
2
$\begingroup$

I guess, the simplest way is:

 ll = {{-1, 1}, {1, 1}, {1, -1}};
 ListPlot[Callout[#, ToString@Position[ll, #][[1, 1]]] & /@ ll]

enter image description here

Or you can take any labels from other list, using the Position[ll, #][[1, 1]]] as index for this label-list

Improve this answer
$\endgroup$

Your Answer

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

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