Divide a rectangle into a number of unequal triangles: Difference between revisions
Divide a rectangle into a number of unequal triangles (view source)
Revision as of 01:14, 17 April 2024
, 1 month agoAdded FreeBASIC
m (→{{header|Wren}}: Changed to Wren S/H) |
(Added FreeBASIC) |
||
Line 12:
* Give a sample of sets of triangles produced from running the algorithm, on this page.
=={{header|FreeBASIC}}==
{{trans|WRen}}
<syntaxhighlight lang="vbnet">Randomize Timer
Function MINIMUM(arr() As Single) As Single
Dim As Single minVal = arr(Lbound(arr))
For i As Integer = Lbound(arr) To Ubound(arr)
If arr(i) < minVal Then minVal = arr(i)
Next i
Return minVal
End Function
Function MAXIMUM(arr() As Single) As Single
Dim As Single maxVal = arr(Lbound(arr))
For i As Integer = Lbound(arr) To Ubound(arr)
If arr(i) > maxVal Then maxVal = arr(i)
Next i
Return maxVal
End Function
Sub pointsOfRect(w As Integer, h As Integer, pts() As Single)
Redim As Single pts(1 To 4, 1 To 2)
pts(1, 1) = 0: pts(1, 2) = 0
pts(2, 1) = h: pts(2, 2) = 0
pts(3, 1) = h: pts(3, 2) = w
pts(4, 1) = 0: pts(4, 2) = w
End Sub
Function dist(p1() As Single, p2() As Single) As Single
Dim As Single dx = p2(1) - p1(1)
Dim As Single dy = p2(2) - p1(2)
Return Sqr(dx * dx + dy * dy)
End Function
Function area(tris() As Single, triIndex As Integer) As Single
Dim As Single aPoint(1 To 2)
Dim As Single bPoint(1 To 2)
aPoint(1) = tris(triIndex, 2, 1): aPoint(2) = tris(triIndex, 2, 2)
bPoint(1) = tris(triIndex, 1, 1): bPoint(2) = tris(triIndex, 1, 2)
Dim a As Single = dist(aPoint(), bPoint())
bPoint(1) = tris(triIndex, 3, 1): bPoint(2) = tris(triIndex, 3, 2)
Dim b As Single = dist(aPoint(), bPoint())
aPoint(1) = tris(triIndex, 1, 1): aPoint(2) = tris(triIndex, 1, 2)
Dim c As Single = dist(aPoint(), bPoint())
Dim s As Single = (a + b + c) * 0.5
Return Sqr(s * (s - a) * (s - b) * (s - c))
End Function
Sub divideRectIntoTris(w As Integer, h As Integer, n As Uinteger, tris() As Single)
Dim As Uinteger i, j, k
If n < 3 Then Print "'n' must be an integer >= 3.": Exit Sub 'END
Dim As Single pts(1 To 4, 1 To 2)
pointsOfRect(w, h, pts())
Dim As Single upper(1 To 3, 1 To 2)
For i = 1 To 3
For j = 1 To 2
upper(i, j) = pts(i, j)
Next j
Next i
Redim As Single tris(1 To n, 1 To 3, 1 To 2)
For i = 1 To 3
For j = 1 To 2
tris(1, i, j) = upper(i, j)
Next j
Next i
Dim As Single xs(1 To n)
xs(n) = w
Dim As Single lens(1 To n - 1)
Do
For i = 1 To n - 2
xs(i) = Rnd * w
Next i
' Sort xs
For i = 1 To n - 1
For j = i + 1 To n
If xs(i) > xs(j) Then Swap xs(i), xs(j)
Next j
Next i
For i = 1 To n - 1
lens(i) = xs(i + 1) - xs(i)
Next i
Loop Until MINIMUM(lens()) <> 0
For i = 1 To n - 1
Dim As Single tri(1 To 3, 1 To 2)
tri(1, 1) = xs(i): tri(1, 2) = 0
tri(2, 1) = pts(3, 1): tri(2, 2) = pts(3, 2)
tri(3, 1) = xs(i + 1): tri(3, 2) = 0
For j = 1 To 3
For k = 1 To 2
tris(i + 1, j, k) = tri(j, k)
Next k
Next j
Next i
End Sub
Dim As Single dims(1 To 2, 1 To 3)
dims(1, 1) = 20: dims(1, 2) = 10: dims(1, 3) = 4
dims(2, 1) = 30: dims(2, 2) = 20: dims(2, 3) = 8
Dim As Integer i, j, triIndex
Dim As Single w, h, n
For dimIndex As Uinteger = 1 To 2
w = dims(dimIndex, 1)
h = dims(dimIndex, 2)
n = dims(dimIndex, 3)
Print "A rectangle with a lower left vertex at (0, 0), width"; w; " and height"; h
Print "can be split into the following"; n; " triangles:"
Dim As Single tris(1 To n, 1 To 3, 1 To 2)
divideRectIntoTris(w, h, n, tris())
Dim As Single areas(1 To n)
Dim As Single tri(1 To 3, 1 To 2)
For triIndex = 1 To n
For i = 1 To 3
For j = 1 To 2
tri(i, j) = tris(triIndex, i, j)
Next j
Next i
areas(triIndex) = area(tris(), triIndex)
Next triIndex
If MINIMUM(areas()) <> MAXIMUM(areas()) Then
For triIndex = 1 To n
Print "[";
For i = 1 To 3
Print "[";
For j = 1 To 2
tri(i, j) = tris(triIndex, i, j)
Print Str(tri(i, j)); ",";
Next j
Print Chr(8); "], ";
Next i
Print Chr(8); Chr(8); "]"
Next triIndex
End If
Print
Next dimIndex
Sleep</syntaxhighlight>
{{out}}
<pre>A rectangle with a lower left vertex at (0, 0), width 20 and height 10
can be split into the following 4 triangles:
[[0,0], [10,0], [10,20]]
[[0,0], [10,20], [9.687466,0]]
[[9.687466,0], [10,20], [14.9594,0]]
[[14.9594,0], [10,20], [20,0]]
A rectangle with a lower left vertex at (0, 0), width 30 and height 20
can be split into the following 8 triangles:
[[0,0], [20,0], [20,30]]
[[0,0], [20,30], [3.175989,0]]
[[3.175989,0], [20,30], [4.040901,0]]
[[4.040901,0], [20,30], [10.83484,0]]
[[10.83484,0], [20,30], [15.34319,0]]
[[15.34319,0], [20,30], [16.37033,0]]
[[16.37033,0], [20,30], [21.38275,0]]
[[21.38275,0], [20,30], [30,0]]</pre>
=={{header|Julia}}==
| |||