fork download
  1. ; pythagorean quadruples
  2.  
  3. (define-syntax fold-of
  4. (syntax-rules (range in is)
  5. ((_ "z" f b e) (set! b (f b e)))
  6. ((_ "z" f b e (v range fst pst stp) c ...)
  7. (let* ((x fst) (p pst) (s stp)
  8. (le? (if (positive? s) <= >=)))
  9. (do ((v x (+ v s))) ((le? p v) b)
  10. (fold-of "z" f b e c ...))))
  11. ((_ "z" f b e (v range fst pst) c ...)
  12. (let* ((x fst) (p pst) (s (if (< x p) 1 -1)))
  13. (fold-of "z" f b e (v range x p s) c ...)))
  14. ((_ "z" f b e (v range pst) c ...)
  15. (fold-of "z" f b e (v range 0 pst) c ...))
  16. ((_ "z" f b e (x in xs) c ...)
  17. (do ((t xs (cdr t))) ((null? t) b)
  18. (let ((x (car t)))
  19. (fold-of "z" f b e c ...))))
  20. ((_ "z" f b e (x is y) c ...)
  21. (let ((x y)) (fold-of "z" f b e c ...)))
  22. ((_ "z" f b e p? c ...)
  23. (if p? (fold-of "z" f b e c ...)))
  24. ((_ f i e c ...)
  25. (let ((b i)) (fold-of "z" f b e c ...)))))
  26.  
  27. (define-syntax list-of (syntax-rules ()
  28. ((_ arg ...) (reverse (fold-of
  29. (lambda (d a) (cons a d)) '() arg ...)))))
  30.  
  31. (define (isqrt n)
  32. (if (not (and (positive? n) (integer? n)))
  33. (error 'isqrt "must be positive integer")
  34. (let loop ((x n))
  35. (let ((y (quotient (+ x (quotient n x)) 2)))
  36. (if (< y x) (loop y) x)))))
  37.  
  38. (define (pyquad n)
  39. (list-of (list a b c d)
  40. (a range 1 (+ n 1))
  41. (b range a (+ n 1))
  42. (c range b (+ n 1))
  43. (s is (+ (* a a) (* b b) (* c c)))
  44. (d is (isqrt s))
  45. (= (* d d) s)))
  46.  
  47. (display (pyquad 25))
Success #stdin #stdout 0.03s 8704KB
stdin
Standard input is empty
stdout
((1 2 2 3) (1 4 8 9) (1 6 18 19) (1 12 12 17) (2 3 6 7) (2 4 4 6) (2 5 14 15) (2 6 9 11) (2 8 16 18) (2 10 11 15) (2 10 25 27) (2 14 23 27) (2 24 24 34) (3 4 12 13) (3 6 6 9) (3 6 22 23) (3 12 24 27) (3 14 18 23) (3 16 24 29) (4 4 7 9) (4 5 20 21) (4 6 12 14) (4 8 8 12) (4 8 19 21) (4 12 18 22) (4 13 16 21) (4 20 22 30) (5 10 10 15) (6 6 7 11) (6 6 17 19) (6 8 24 26) (6 9 18 21) (6 10 15 19) (6 12 12 18) (6 13 18 23) (6 21 22 31) (7 14 14 21) (7 14 22 27) (8 8 14 18) (8 9 12 17) (8 11 16 21) (8 12 24 28) (8 16 16 24) (8 20 25 33) (9 12 20 25) (9 18 18 27) (10 10 23 27) (10 20 20 30) (11 12 24 29) (11 22 22 33) (12 12 14 22) (12 12 21 27) (12 15 16 25) (12 16 21 29) (12 24 24 36) (14 18 21 31) (16 18 24 34) (17 20 20 33) (18 18 21 33) (23 24 24 41))