#lang at-exp scheme
(require (planet soegaard/infix))
(require (planet "while.scm" ("soegaard" "control.plt" 2 0))) (define-values (f g t) (values 1 2 0))
(define sum f)
@${
while[ g< 4000000,
when[ even?[g], sum:=sum+g] t := f + g f := g g := t]sum}
(define n 0)
(define ns 0)
(define squares 0)
@${
sum:=0while[ n<100,
n := n+1 ns := ns+n squares := squares + n^2]ns^2-squares
}
(let-values ([(a b c) (values 0 0 0)])
(let/cc return
(for ([k (in-range 1 100)])
(for ([m (in-range 2 1000)])
(for ([n (in-range 1 m)])
@${ a := k* 2*m*n b := k* (m^2 - n^2) c := k* (m^2 + n^2) when[ a+b+c = 1000,
display[{{k,m,n}, {a,b,c}}] newline[] return[a*b*c] ]})))))
(define (factor2 n)
(let loop ([r 0] [s n])
(let-values ([(q r) (quotient/remainder s 2)])
(if (zero? r)
(loop (+ r 1) q)
(values r s)))))
(require srfi/27)
(define (miller-rabin n)
(define (mod x) (modulo x n))
(define (expt x m)
(cond [(zero? m) 1]
[(even? m) @${mod[sqr[x^(m/2)] ]}]
[(odd? m) @${mod[x*x^(m-1)]}]))
(define (check? a)
(let-values ([(r s) (factor2 (sub1 n))])
(and @${member[a^s,{1,mod[-1]}]} #t)))
(andmap check?
(build-list 50 (λ (_) (+ 2 (random-integer (- n 3)))))))
(define (prime? n)
(cond [(< n 2) #f]
[(= n 2) #t]
[(even? n) #f]
[else (miller-rabin n)]))
(prime? @${2^89-1})