Data commit

Task/Heronian-triangles/FreeBASIC/heronian-triangles.basic

@@ -0,0 +1,147 @@
+' 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