Skip to main content

mesh - Writing loops for triangle elements


enter image description here


I'm kind of new to using Mathematica, so any help is great. I'm trying to write a program that will create a list or matrix that will give each small triangle's point numbers. For example if given an isosceles right triangle, the example below gives the sides as 4 and the numbering of the points is just like below, then it should give a list or table such as


dat= {{1,2,6},{2,3,7},{3,4,8},{4,5,9},{6,7,10},{7,8,11},{8,9,12},{10,11,13},

{11,12,14},{13,14,15},{2,6,7},{3,7,8},{4,8,9},{7,10,11},{8,11,12},{11,13,14}}.

I've tried writing a few loops, but am not getting anywhere. I know that the starting number on the diagonal of the big triangle will add whatever the side is and start decreasing that value as u go up. For example, the first point always starts at 1, and as u move up the rows of triangle, you add 1+(x+1) to get 6. Then going up the next row of triangles, it is 6+(x), to get 10. And so on. So I see two iterators? once increasing? one decreasing? Any help or ideas will be helpful. Thanks!



Answer



A revision of my earlier, hurried function:


fn[_, 0] := {}

fn[s_:1, n_] := Join[
Rest @ Array[Thread @ {#, # + {n, 1}, # + n + 1} &, n, s, Join],
fn[s + n + 1, n - 1]

]

Test:


fn[4]


{{1, 2, 6}, {2, 6, 7}, {2, 3, 7}, {3, 7, 8}, {3, 4, 8}, {4, 8, 9}, {4, 5, 9},
{6, 7, 10}, {7, 10, 11}, {7, 8, 11}, {8, 11, 12}, {8, 9, 12}, {10, 11, 13},
{11, 13, 14}, {11, 12, 14}, {13, 14, 15}}


It is a recursive function that calls itself. It operates line by line; it keeps track of two values: s which is the starting number (defaulting to one), and n which is the number of lines left to go (your input value to begin with). I shall try to add a full breakdown of the code later.




Breakdown


Starting from the innermost part I wrote a Function that takes a single number and returns the corresponding triangle points, given the correct value for n. For point 3 in the bottom line of your diagram:


n = 4; (* there are four lines above point 3 *)

{#, # + {n, 1}, # + n + 1} &[3]


{3, {7, 4}, 8}


This represents two paths, either 3, 7, 8 or 3, 4, 8; I expand it using Thread:


Thread @ {3, {7, 4}, 8}


{{3, 7, 8}, {3, 4, 8}}

I use this function in Array, with the additional parameter s which is the starting number for that line. For the first line in the diagram it is 1, for the second 6, the third 10, etc. Using the second line as an example:


n = 3;
s = 6;

Array[Thread @ {#, # + {n, 1}, # + n + 1} &, n, s, Join]


{{6, 9, 10}, {6, 7, 10}, {7, 10, 11}, {7, 8, 11}, {8, 11, 12}, {8, 9, 12}}

Note that we have an incorrect triplet: {6, 9, 10}. This occurs at the start of each line because the line above is one element shorter; I get rid of it using Rest.


We now have a function to generate triplets for each line. To find all lines I have the function call itself with the parameters for the line above it and Join the results. When the outer function (fn) is called with 0 for parameter n meaning "zero lines above" it returns an empty set ({}) and the recursion terminates.


Comments

Popular posts from this blog

plotting - Filling between two spheres in SphericalPlot3D

Manipulate[ SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, Mesh -> None, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], {n, 0, 1}] I cant' seem to be able to make a filling between two spheres. I've already tried the obvious Filling -> {1 -> {2}} but Mathematica doesn't seem to like that option. Is there any easy way around this or ... Answer There is no built-in filling in SphericalPlot3D . One option is to use ParametricPlot3D to draw the surfaces between the two shells: Manipulate[ Show[SphericalPlot3D[{1, 2 - n}, {θ, 0, Pi}, {ϕ, 0, 1.5 Pi}, PlotPoints -> 15, PlotRange -> {-2.2, 2.2}], ParametricPlot3D[{ r {Sin[t] Cos[1.5 Pi], Sin[t] Sin[1.5 Pi], Cos[t]}, r {Sin[t] Cos[0 Pi], Sin[t] Sin[0 Pi], Cos[t]}}, {r, 1, 2 - n}, {t, 0, Pi}, PlotStyle -> Yellow, Mesh -> {2, 15}]], {n, 0, 1}]

plotting - Plot 4D data with color as 4th dimension

I have a list of 4D data (x position, y position, amplitude, wavelength). I want to plot x, y, and amplitude on a 3D plot and have the color of the points correspond to the wavelength. I have seen many examples using functions to define color but my wavelength cannot be expressed by an analytic function. Is there a simple way to do this? Answer Here a another possible way to visualize 4D data: data = Flatten[Table[{x, y, x^2 + y^2, Sin[x - y]}, {x, -Pi, Pi,Pi/10}, {y,-Pi,Pi, Pi/10}], 1]; You can use the function Point along with VertexColors . Now the points are places using the first three elements and the color is determined by the fourth. In this case I used Hue, but you can use whatever you prefer. Graphics3D[ Point[data[[All, 1 ;; 3]], VertexColors -> Hue /@ data[[All, 4]]], Axes -> True, BoxRatios -> {1, 1, 1/GoldenRatio}]

plotting - Adding a thick curve to a regionplot

Suppose we have the following simple RegionPlot: f[x_] := 1 - x^2 g[x_] := 1 - 0.5 x^2 RegionPlot[{y < f[x], f[x] < y < g[x], y > g[x]}, {x, 0, 2}, {y, 0, 2}] Now I'm trying to change the curve defined by $y=g[x]$ into a thick black curve, while leaving all other boundaries in the plot unchanged. I've tried adding the region $y=g[x]$ and playing with the plotstyle, which didn't work, and I've tried BoundaryStyle, which changed all the boundaries in the plot. Now I'm kinda out of ideas... Any help would be appreciated! Answer With f[x_] := 1 - x^2 g[x_] := 1 - 0.5 x^2 You can use Epilog to add the thick line: RegionPlot[{y < f[x], f[x] < y < g[x], y > g[x]}, {x, 0, 2}, {y, 0, 2}, PlotPoints -> 50, Epilog -> (Plot[g[x], {x, 0, 2}, PlotStyle -> {Black, Thick}][[1]]), PlotStyle -> {Directive[Yellow, Opacity[0.4]], Directive[Pink, Opacity[0.4]],