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

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...