Message Boards Message Boards

GROUPS:

Improve code for finding the coordinates of a triangular mesh?

Posted 3 months ago
643 Views
|
6 Replies
|
0 Total Likes
|

Hello, The problem of finding the coordinates of a triangular (equilateral) mesh discussed earlier is solved. It also counts the number of equilateral triangles formed by the intersecting parallel lines. But the problem is that the code takes more time for larger values of n i.e. the size of the side of the triangle. Can the code be improved? The code is given here. Thanks for any suggestion.

n = 4;
Print["Number of lines/size of triangle = ", n]
h = Sqrt[3] /2;
Array[x, n];
Array[s, n];
x[0] = {{n/2, n h}};
For[i = 1, i <= n, i++, 
  x[i] = Table[{x[0][[1, 1]] - i/2 + j, n h - i h}, {j, 0, i}]];
set = Apply[Union, Table[x[i], {i, 0, n}]];
Print["Number of vertices = ", Length[set]]
cond := (EuclideanDistance[#[[1]], #[[2]]] == 
     EuclideanDistance[#[[2]], #[[3]]] == 
     EuclideanDistance[#[[1]], #[[3]]] && #[[1]] != #[[2]] != #[[
      3]] && #[[1, 1]] <  #[[2, 1]] < #[[3, 
      1]] && (#[[1, 2]] == #[[2, 2]] || #[[2, 2]] == #[[3, 2]] || #[[
        3, 2]] == #[[1, 2]]) &)
tr0 = Tuples[set, 3];
tr1 = Select[tr0, cond];
Print["Number of Triangles = ", Length[tr1]]
6 Replies

This is in co-ordinate system

\[Alpha] {[0, 0}, {1, 0}} \[CirclePlus] \[Beta] {{0, 0}, {1/2, 
Srqt[3]/2}}, \[Alpha] >= 0, \[Beta] >= 0, 0 <= \[Alpha] + \[Beta] \<= n;

only equilateral triangles are considered, so one computes the number of all equilateral triangles directly:

In[44]:= (* number of vertices *)
Clear[v]
RSolve[v[n + 1] - v[n] - n == 2, v[n], n]
Out[45]= {{v[n] -> -(1/2) (-2 - n) (1 + n) + C[1]}}

In[46]:= Clear[v]
v[n_Integer?NonNegative] := (n + 1) (n + 2)/2

In[48]:= v[83]
Out[48]= 3570

In[57]:= (* number of length 1 edges *)
Clear[ed]
RSolve[ed[n + 1] - ed[n] == 3 (n + 1), ed[n], n]
Out[58]= {{ed[n] -> -(3/2) (-1 - n) n + C[1]}}

In[59]:= Clear[ed]
ed[n_Integer?NonNegative] := 3 n (n + 1)/2

In[64]:= ed[4]
Out[64]= 30

In[85]:= (* number of edge length 1 equilateral triangles *)
Clear[t]
t[n_Integer?NonNegative] := n^2


In[87]:= (* number of all equilateral triangles *)
Clear[tt]
tt[n_Integer?NonNegative] := 
 t[n] + Sum[v[n - m], {m, 2, n}] + Sum[v[n - 2 m], {m, 2, Floor[n/2]}]


In[89]:= tt /@ Range[0, 7]
Out[89]= {0, 1, 5, 13, 27, 48, 78, 118}

Thank you Sir for the suggestion but I am sorry the steps are not very much clear to me. A little more elaboration will be helpful .

The border of points in set is itself an equilateral triangle. So one should count: the equilateral triangles of edge length 1 by their leftmost corner

In[28]:= FindInstance[t[p] == v[p - 1] + v[p - 2], p, Integers, 3]
Out[28]= {{p -> 226}, {p -> 31}, {p -> 675}} 

this is an identity and of course

  • v[p-1] is the number of upright ( $\Delta$) triangles and
  • v[p-2] is the number of downright ( $\nabla$) triangles.

Then here

(* number of all equilateral triangles *)
Clear[tt]
tt[n_Integer?NonNegative] := 
 t[n] + Sum[v[n - m], {m, 2, n}] + Sum[v[n - 2 m], {m, 2, Floor[n/2]}]

gives the second summand the number of upright triangles with edge length m and the third summand is the number of downright triangles with edge length m.

Thank you Sir for the nice explanation. By taking small values for n (The maximum edge length) and studying the pattern I have formulated the number of equilateral triangles as follows: 1. Number of Upward triangles = 1.n+2.(n-1)+3.(n-2)+…+n.1 = n(n+1)(n+2)/6 after simplification 2. Number of Downward triangles = (i) (1+2)+(1+2+3+4)+(1+2+3+4+5+6)+…up to (n-1)/2 terms, when n is ODD = (n-1)(n+1)(2 n+3)/24 after simplification And (ii) 1+(1+2+3)+(1+2+3+4+5)+….up to n/2 terms, when n is EVEN = n(n+2)(2 n-1)/24 after simplification ,

(*n = NUmber of Parallel lines = Maximum edge length*)
uptr[n_] := n (n + 1) (n + 2)/6;
dntr[n_] := 
  If[EvenQ[n], n (n + 2) (2 n - 1)/24, (n - 1) (n + 1) (2 n + 3)/24];
(uptr[#] + dntr[#] &) /@ Range[0, 10]

Run

In[11]:= FindLinearRecurrence[tt /@ Range[0, 44]]
Out[11]= {3, -2, -2, 3, -1}

In[24]:= (* shift by 1 *)
LinearRecurrence[{3, -2, -2, 3, -1}, {0, 1, 5, 13, 27, 48}, #] & /@ {{0, 4}, {44, 45}}
Out[24]= {{0, 0, 1, 5, 13}, {21043, 22517}}

In[33]:= RSolve[a[n + 5] == 
                Reverse[{3, -2, -2, 3, -1}] . (a[n + #] & /@ Range[0, 4]), a[n], n]
Out[33]= {{a[n] -> (-1)^n C[1] + C[2] + n C[3] + n^2 C[4] + n^3 C[5]}}

to catch up with A002717 - OEIS of The On-Line Encyclopedia of Integer Sequences.

It did not occur to me the use of recurrence relations.Thank you very much Sir for the guidance. Regards.

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract