Heronian triangles: Difference between revisions

Added Factor
m (→‎{{header|C}}: Remove vanity tags)
(Added Factor)
Line 1,344:
7 65 68 140 210
3 148 149 300 210</pre>
 
=={{header|Factor}}==
<lang factor>USING: accessors assocs backtrack combinators.extras
combinators.short-circuit formatting io kernel locals math
math.functions math.order math.parser math.ranges mirrors qw
sequences sorting.slots ;
IN: rosetta-code.heronian-triangles
 
TUPLE: triangle a b c area perimeter ;
 
:: area ( a b c -- x )
a b + c + 2 / :> s
s s a - * s b - * s c - * sqrt ;
 
: <triangle> ( triplet-seq -- triangle )
[ first3 ] [ first3 area >integer ] [ sum ] tri
triangle boa ;
 
: heronian? ( a b c -- ? )
area dup [ complex? ] [ 0 number= ] bi or
[ drop f ] [ dup >integer number= ] if ;
: 3gcd ( a b c -- n ) [ gcd nip ] twice ;
: primitive-heronian? ( a b c -- ? )
{ [ 3gcd 1 = ] [ heronian? ] } 3&& ;
 
:: find-triangles ( -- seq )
[
200 [1,b] amb-lazy :> c ! Use backtrack vocab to test
c [1,b] amb-lazy :> b ! permutations of sides such
b [1,b] amb-lazy :> a ! that c >= b >= a.
a b c primitive-heronian? must-be-true
{ a b c } <triangle>
] bag-of ; ! collect every triangle
: sort-triangles ( seq -- seq' )
{ { area>> <=> } { perimeter>> <=> } } sort-by ;
CONSTANT: format "%4s%5s%5s%5s%10s\n"
: print-header ( -- )
qw{ a b c area perimeter } format vprintf
"---- ---- ---- ---- ---------" print ;
: print-triangle ( triangle -- )
<mirror> >alist values [ number>string ] map format vprintf ;
 
: print-triangles ( seq -- ) [ print-triangle ] each ; inline
: first10 ( sorted-triangles -- )
dup length "%d triangles found. First 10: \n" printf
print-header 10 head print-triangles ;
: area210= ( sorted-triangles -- )
"Triangles with area 210: " print print-header
[ area>> 210 = ] filter print-triangles ;
: main ( -- )
"Finding heronian triangles with sides <= 200..." print nl
find-triangles sort-triangles
[ first10 nl ] [ area210= ] bi ;
MAIN: main</lang>
{{out}}
<pre>
Finding heronian triangles with sides <= 200...
 
517 triangles found. First 10:
a b c area perimeter
---- ---- ---- ---- ---------
3 4 5 6 12
5 5 6 12 16
5 5 8 12 18
4 13 15 24 32
5 12 13 30 30
9 10 17 36 36
3 25 26 36 54
7 15 20 42 42
10 13 13 60 36
8 15 17 60 40
 
Triangles with area 210:
a b c area perimeter
---- ---- ---- ---- ---------
17 25 28 210 70
20 21 29 210 70
12 35 37 210 84
17 28 39 210 84
7 65 68 210 140
3 148 149 210 300
</pre>
 
=={{header|Fortran}}==
1,827

edits