September Morn Update

This commit is contained in:
Ingy döt Net 2019-09-12 10:33:56 -07:00
parent 4e2d22a71d
commit aac6731f2c
6856 changed files with 141342 additions and 21127 deletions

View file

@ -0,0 +1 @@
--- {}

View file

@ -3,17 +3,15 @@
(loop for y in x
for z in b sum (* y z))))
(defun count-tri (lim)
(let ((prim 0) (cnt 0))
(labels ((count1 (tr)
(let ((peri (reduce #'+ tr)))
(when (<= peri lim)
(incf prim)
(incf cnt (truncate lim peri))
(count1 (mmul '(( 1 -2 2) ( 2 -1 2) ( 2 -2 3)) tr))
(count1 (mmul '(( 1 2 2) ( 2 1 2) ( 2 2 3)) tr))
(count1 (mmul '((-1 2 2) (-2 1 2) (-2 2 3)) tr))))))
(count1 '(3 4 5))
(format t "~a: ~a prim, ~a all~%" lim prim cnt))))
(defun count-tri (lim &aux (prim 0) (cnt 0))
(labels ((count1 (tr &aux (peri (reduce #'+ tr)))
(when (<= peri lim)
(incf prim)
(incf cnt (truncate lim peri))
(count1 (mmul '(( 1 -2 2) ( 2 -1 2) ( 2 -2 3)) tr))
(count1 (mmul '(( 1 2 2) ( 2 1 2) ( 2 2 3)) tr))
(count1 (mmul '((-1 2 2) (-2 1 2) (-2 2 3)) tr)))))
(count1 '(3 4 5))
(format t "~a: ~a prim, ~a all~%" lim prim cnt)))
(loop for p from 2 do (count-tri (expt 10 p)))

View file

@ -0,0 +1,30 @@
class PythagoranTriplesCounter
def initialize(limit = 0)
@limit = limit
@total = 0
@primitives = 0
generate_triples(3, 4, 5)
end
def total; @total end
def primitives; @primitives end
private def generate_triples(a, b, c)
perim = a + b + c
return if perim > @limit
@primitives += 1
@total += @limit / perim
generate_triples( a-2*b+2*c, 2*a-b+2*c, 2*a-2*b+3*c )
generate_triples( a+2*b+2*c, 2*a+b+2*c, 2*a+2*b+3*c )
generate_triples(-a+2*b+2*c,-2*a+b+2*c,-2*a+2*b+3*c )
end
end
perim = 10
while perim <= 100_000_000
c = PythagoranTriplesCounter.new perim
p [perim, c.total, c.primitives]
perim *= 10
end

View file

@ -0,0 +1,22 @@
:- module comprehension.
:- interface.
:- import_module io.
:- import_module int.
:- type triple ---> triple(int, int, int).
:- pred pythTrip(int::in,triple::out) is nondet.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module solutions.
pythTrip(Limit,triple(X,Y,Z)) :-
nondet_int_in_range(1,Limit,X),
nondet_int_in_range(X,Limit,Y),
nondet_int_in_range(Y,Limit,Z),
pow(Z,2) = pow(X,2) + pow(Y,2).
main(!IO) :-
solutions((pred(Triple::out) is nondet :- pythTrip(20,Triple)),Result),
write(Result,!IO).

View file

@ -0,0 +1,28 @@
; triples generator based on Euclid's formula, creates lazy list
(define (euclid-formula max)
(let loop ((a 3) (b 4) (c 5) (tail #null))
(if (<= (+ a b c) max)
(cons (tuple a b c) (lambda ()
(let ((d (- b)) (z (- a)))
(loop (+ a d d c c) (+ a a d c c) (+ a a d d c c c) (lambda ()
(loop (+ a b b c c) (+ a a b c c) (+ a a b b c c c) (lambda ()
(loop (+ z b b c c) (+ z z b c c) (+ z z b b c c c) tail))))))))
tail)))
; let's do calculations
(define (calculate max)
(let loop ((p 0) (t 0) (ll (euclid-formula max)))
(cond
((null? ll)
(cons p t))
((function? ll)
(loop p t (ll)))
(else
(let ((triple (car ll)))
(loop (+ p 1) (+ t (div max (apply + triple)))
(cdr ll)))))))
; print values for 10..100000
(for-each (lambda (max)
(print max ": " (calculate max)))
(map (lambda (n) (expt 10 n)) (iota 6 1)))

View file

@ -1,18 +1,14 @@
my %triples;
my $limit = 10000;
for 3 .. $limit/2 -> $c {
my atomicint $i = 0;
my @triples[$limit/2];
(3 .. $limit/2).race.map: -> $c {
for 1 .. $c -> $a {
my $b = ($c * $c - $a * $a).sqrt;
last if $c + $a + $b > $limit;
last if $a > $b;
if $b == $b.Int {
my $key = "$a $b $c";
%triples{$key} = ([gcd] $c, $a, $b.Int) > 1 ?? 0 !! 1;
say $key, %triples{$key} ?? ' - primitive' !! '';
}
@triples[$i++] = ([gcd] $c, $a, $b) > 1 ?? 0 !! 1 if $b == $b.Int;
}
}
say "There are {+%triples.keys} Pythagorean Triples with a perimeter <= $limit,"
~"\nof which {[+] %triples.values} are primitive.";
say my $result = "There are {+@triples.grep:{$_ !eqv Any}} Pythagorean Triples with a perimeter <= $limit,"
~"\nof which {[+] @triples.grep: so *} are primitive.";

View file

@ -5,7 +5,7 @@ sub triples($limit) {
sub oyako($a, $b, $c) {
my $perim = $a + $b + $c;
return if $perim > $limit;
++$primitive; $civilized += $limit div $perim;
++$primitive; $civilized += $limit div $perim;
oyako( $a - 2*$b + 2*$c, 2*$a - $b + 2*$c, 2*$a - 2*$b + 3*$c);
oyako( $a + 2*$b + 2*$c, 2*$a + $b + 2*$c, 2*$a + 2*$b + 3*$c);
oyako(-$a + 2*$b + 2*$c, -2*$a + $b + 2*$c, -2*$a + 2*$b + 3*$c);

View file

@ -18,6 +18,6 @@ sub triples($limit) {
"$limit => ({$complex.re, $complex.im})";
}
for 10,100,1000 ... * -> $limit {
for 10, 100, 1000, 10000 -> $limit {
say triples $limit;
}

View file

@ -1,24 +1,25 @@
/*REXX program counts the number of Pythagorean triples that exist given a maximum */
/*──────────────────── perimeter of N, and also counts how many of them are primitives.*/
parse arg N . /*obtain optional argument from the CL.*/
if N=='' | N=="," then n=100 /*Not specified? Then use the default.*/
T=0; P=0 /*set the number of Triples, Primitives*/
do a=3 to N%3; aa=a*a /*limit side to 1/3 of the perimeter.*/
do b=a+1 /*the triangle can't be isosceles. */
ab=a + b /*compute a partial perimeter (2 sides)*/
if ab>=N then iterate a /*is a+b ≥ perimeter? Try different A*/
aabb=aa + b*b /*compute the sum of a²+b² (shortcut)*/
if N=='' | N=="," then N= 100 /*Not specified? Then use the default.*/
do j=1 for N; @.j= j*j; end /*pre-compute some squares. */
N66= N * 2%3 /*calculate 2/3 of N (for a+b). */
T= 0; P= 0 /*set the number of Triples, Primitives*/
do a=3 to N%3 /*limit side to 1/3 of the perimeter.*/
do b= a+1 /*the triangle can't be isosceles. */
ab= a + b /*compute a partial perimeter (2 sides)*/
if ab>=N66 then iterate a /*is a+b≥66% perimeter? Try different A*/
aabb= @.a + @.b /*compute the sum of a²+b² (shortcut)*/
do c=b+1 /*compute the value of the third side. */
if ab+c > N then iterate a /*is a+b+c > perimeter? Try diff. A.*/
cc=c*c /*compute the value of C². */
if cc > aabb then iterate b /*is c² > a²+b² ? Try a different B.*/
if cc\==aabb then iterate /*is c² ¬= a²+b² ? Try a different C.*/
T=T + 1 /*eureka. We found a Pythagorean triple*/
P=P + (gcd(a, b)==1) /*is this triple a primitive triple? */
if ab+c > N then iterate a /*is a+b+c>perimeter ? Try different A.*/
if @.c >aabb then iterate b /*is c² > a²+b² ? Try " B.*/
if @.c\==aabb then iterate /*is c² ¬= a²+b² ? Try " C.*/
T= T + 1 /*eureka. We found a Pythagorean triple*/
P= P + (gcd(a, b)==1) /*is this triple a primitive triple? */
end /*c*/
end /*b*/
end /*a*/
_=left('', 7) /*for padding the output with 7 blanks.*/
_= left('', 7) /*for padding the output with 7 blanks.*/
say 'max perimeter =' N _ "Pythagorean triples =" T _ 'primitives =' P
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/

View file

@ -1,31 +1,29 @@
/*REXX program counts the number of Pythagorean triples that exist given a maximum */
/*──────────────────── perimeter of N, and also counts how many of them are primitives.*/
parse arg N . /*obtain optional argument from the CL.*/
if N=='' | N=="," then n=100 /*Not specified? Then use the default.*/
T=0; P=0 /*set the number of Triples, Primitives*/
@.=0; do a=3 to N%3; aa=a*a /*limit side to 1/3 of the perimeter.*/
if N=='' | N=="," then N= 100 /*Not specified? Then use the default.*/
@.= 0; do j=1 for N; @.j= j*j; end /*pre-compute some squares. */
N66= N * 2%3 /*calculate 2/3 of N (for a+b). */
P= 0; T= 0; do a=3 to N%3 /*limit side to 1/3 of the perimeter.*/
aEven= a//2==0 /*set variable to 1 if A is even. */
do b=a+1 by 1+aEven /*the triangle can't be isosceles. */
ab=a + b /*compute a partial perimeter (2 sides)*/
if ab>=N then iterate a /*is a+b ≥ perimeter? Try different A*/
aabb=aa + b*b /*compute the sum of a²+b² (shortcut)*/
do b=a+1 by 1+aEven; ab= a + b /*the triangle can't be isosceles. */
if ab>=N66 then iterate a /*is a+b≥66% perimeter? Try different A*/
aabb= @.a + @.b /*compute the sum of a²+b² (shortcut)*/
do c=b + 1 /*compute the value of the third side. */
if aEven then if c//2==0 then iterate
if ab+c>n then iterate a /*a+b+c > perimeter? Try different A.*/
cc=c*c /*compute the value of C². */
if cc > aabb then iterate b /*is c² > a²+b² ? Try a different B.*/
if cc\==aabb then iterate /*is c² ¬= a²+b² ? Try a different C.*/
if @.a.b.c then iterate /*Is this a duplicate? Then try again.*/
T=T + 1 /*Eureka! We found a Pythagorean triple*/
P=P + 1 /*count this also as a primitive triple*/
if aEven then if c//2==0 then iterate /*both A&C even? Skip it*/
if ab+c>n then iterate a /*a+b+c > perimeter? Try different A. */
if @.c > aabb then iterate b /*is c² > a²+b² ? " " B. */
if @.c\==aabb then iterate /*is c² ¬= a²+b² ? " " C. */
if @.a.b.c then iterate /*Is this a duplicate? Then try again.*/
T= T + 1 /*Eureka! We found a Pythagorean triple*/
P= P + 1 /*count this also as a primitive triple*/
do m=2 while a*m+b*m+c*m<=N /*generate non-primitives Pythagoreans.*/
T=T + 1 /*Eureka! We found a Pythagorean triple*/
am=a*m; bm=b*m; cm=c*m /*create some short-cut variable names.*/
@.am.bm.cm=1 /*mark Pythagorean triangle as a triple*/
T= T + 1 /*Eureka! We found a Pythagorean triple*/
am= a*m; bm= b*m; cm= c*m /*create some short-cut variable names.*/
@.am.bm.cm= 1 /*mark Pythagorean triangle as a triple*/
end /*m*/
end /*c*/
end /*b*/
end /*a*/
_=left('', 7) /*for padding the output with 7 blanks.*/
end /*a*/ /*stick a fork in it, we're all done. */
_= left('', 7) /*for padding the output with 7 blanks.*/
say 'max perimeter =' N _ "Pythagorean triples =" T _ 'primitives =' P
/*stick a fork in it, we're all done. */

View file

@ -0,0 +1,22 @@
Dim total As Variant, prim As Variant, maxPeri As Variant
Private Sub newTri(s0 As Variant, s1 As Variant, s2 As Variant)
Dim p As Variant
p = CDec(s0) + CDec(s1) + CDec(s2)
If p <= maxPeri Then
prim = prim + 1
total = total + maxPeri \ p
newTri s0 + 2 * (-s1 + s2), 2 * (s0 + s2) - s1, 2 * (s0 - s1 + s2) + s2
newTri s0 + 2 * (s1 + s2), 2 * (s0 + s2) + s1, 2 * (s0 + s1 + s2) + s2
newTri -s0 + 2 * (s1 + s2), 2 * (-s0 + s2) + s1, 2 * (-s0 + s1 + s2) + s2
End If
End Sub
Public Sub Program_PythagoreanTriples()
maxPeri = CDec(100)
Do While maxPeri <= 10000000#
prim = CDec(0)
total = CDec(0)
newTri 3, 4, 5
Debug.Print "Up to "; maxPeri; ": "; total; " triples, "; prim; " primitives."
maxPeri = maxPeri * 10
Loop
End Sub

View file

@ -0,0 +1,28 @@
Option Explicit
Dim total As Long, prim As Long, maxPeri As Long
Public Sub NewTri(ByVal s0 As Long, ByVal s1 As Long, ByVal s2 As Long)
Dim p As Long, x1 As Long, x2 As Long
p = s0 + s1 + s2
If p <= maxPeri Then
prim = prim + 1
total = total + maxPeri \ p
x1 = s0 + s2
x2 = s1 + s2
NewTri s0 + 2 * (-s1 + s2), 2 * x1 - s1, 2 * (x1 - s1) + s2
NewTri s0 + 2 * x2, 2 * x1 + s1, 2 * (x1 + s1) + s2
NewTri -s0 + 2 * x2, 2 * (-s0 + s2) + s1, 2 * (-s0 + x2) + s2
End If
End Sub
Public Sub Main()
maxPeri = 100
Do While maxPeri <= 10& ^ 8
prim = 0
total = 0
NewTri 3, 4, 5
Debug.Print "Up to "; maxPeri; ": "; total; " triples, "; prim; " primitives."
maxPeri = maxPeri * 10
Loop
End Sub