147 lines
3.6 KiB
Text
147 lines
3.6 KiB
Text
' version 02-05-2016
|
|
' compile with: fbc -s console
|
|
|
|
#Macro header
|
|
Print
|
|
Print " a b c s area"
|
|
Print "-----------------------------------"
|
|
#EndMacro
|
|
|
|
Type triangle
|
|
Dim As UInteger a
|
|
Dim As UInteger b
|
|
Dim As UInteger c
|
|
Dim As UInteger s
|
|
Dim As UInteger area
|
|
End Type
|
|
|
|
Function gcd(x As UInteger, y As UInteger) As UInteger
|
|
|
|
Dim As UInteger t
|
|
|
|
While y
|
|
t = y
|
|
y = x Mod y
|
|
x = t
|
|
Wend
|
|
|
|
Return x
|
|
|
|
End Function
|
|
|
|
Function Heronian_triangles(a_max As UInteger, b_max As UInteger, _
|
|
c_max As UInteger, result() As triangle) As UInteger
|
|
|
|
Dim As UInteger a, b, c
|
|
Dim As UInteger s, sqroot, total, temp
|
|
|
|
For a = 1 To a_max
|
|
For b = a To b_max
|
|
' make sure that a + b + c is even
|
|
For c = b + (a And 1) To c_max Step 2
|
|
' to form a triangle a + b must be greater then c
|
|
If (a + b) <= c Then Exit For
|
|
' check if a, b and c have a common divisor
|
|
If (gcd(c, b) <> 1 And gcd(c, a) <> 1) Then
|
|
Continue For
|
|
End If
|
|
s = (a + b + c) \ 2
|
|
temp = s * (s - a) * (s - b) * (s - c)
|
|
sqroot = Sqr(temp)
|
|
If (sqroot * sqroot) = temp Then
|
|
total += 1
|
|
With result(total)
|
|
.a = a
|
|
.b = b
|
|
.c = c
|
|
.s = s
|
|
.area = sqroot
|
|
End With
|
|
End If
|
|
Next
|
|
Next
|
|
Next
|
|
|
|
Return total
|
|
|
|
End Function
|
|
|
|
|
|
Sub sort_tri(result() As triangle, total As UInteger)
|
|
' shell sort
|
|
' sort order: area, s, c
|
|
|
|
Dim As UInteger x, y, inc, done
|
|
|
|
inc = total
|
|
Do
|
|
inc = IIf(inc > 1, inc \ 2, 1)
|
|
Do
|
|
done = 0
|
|
For x = 1 To total - inc
|
|
y = x + inc
|
|
If result(x).area > result(y).area Then
|
|
Swap result(x), result(y)
|
|
done = 1
|
|
Else
|
|
If result(x).area = result(y).area Then
|
|
If result(x).s > result(y).s Then
|
|
Swap result(x), result(y)
|
|
done = 1
|
|
Else
|
|
If result(x).s = result(y).s Then
|
|
If result(x).c > result(y).c Then
|
|
Swap result(x), result(y)
|
|
done = 1
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
Loop Until done = 0
|
|
Loop Until inc = 1
|
|
|
|
End Sub
|
|
|
|
|
|
' ------=< MAIN >=------
|
|
|
|
ReDim result(1 To 1000) As triangle
|
|
Dim As UInteger x, y, total
|
|
|
|
total = Heronian_triangles(200, 200, 200, result() )
|
|
|
|
' trim the array by removing empty entries
|
|
ReDim Preserve result(1 To total ) As triangle
|
|
|
|
sort_tri(result(), total)
|
|
|
|
Print "There are ";total;" Heronian triangles with sides <= 200"
|
|
Print
|
|
|
|
Print "First ten sorted entries"
|
|
header ' print header
|
|
For x = 1 To IIf(total > 9, 10, total)
|
|
With result(x)
|
|
Print Using " #####"; .a; .b; .c; .s; .area
|
|
End With
|
|
Next
|
|
Print
|
|
Print
|
|
|
|
Print "Entries with a area = 210"
|
|
header ' print header
|
|
For x = 1 To UBound(result)
|
|
With result(x)
|
|
If .area = 210 Then
|
|
Print Using " #####"; .a; .b; .c; .s; .area
|
|
End If
|
|
End With
|
|
Next
|
|
|
|
' empty keyboard buffer
|
|
While Inkey <> "" : Wend
|
|
Print : Print "hit any key to end program"
|
|
Sleep
|
|
End
|