Divide a rectangle into a number of unequal triangles: Difference between revisions

Added FreeBASIC
m (syntax highlighting fixup automation)
(Added FreeBASIC)
 
(One intermediate revision by one other user not shown)
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}}==
Line 519 ⟶ 673:
 
This process should ensure that all the triangles are different, albeit the first one is usually much larger than the others. However, to be absolutely sure, we check that the areas of all the triangles are different.
<syntaxhighlight lang="ecmascriptwren">import "random" for Random
import "./seq" for Lst
 
2,130

edits