ラグランジュの四平方定理

演習問題の、ラグランジュの四平方定理(2003年 ICPC アジア地区予選 会津大会 問題B)

http://osmag.jp/articles/root/root93.html

(define (lag n)
  (define count 0)
  (define (cmp l)
    (let1 s (apply + (map (lambda (x) (* x x)) l))
      (cond
       ((= s n) 0)
       ((> s n) 1)
       (else -1))))
  
  (let loop0 ((a (x->integer (sqrt n))))
    (unless (< a 0)
      (unless (= 1 (cmp (list a)))
        (let loop1 ((b a))
          (unless (< b 0)
            (unless (= 1 (cmp (list a b)))
              (let loop2 ((c b))
                (unless (< c 0)
                  (unless (= 1 (cmp (list a b c)))
                    (let loop3 ((d c))
                      (unless (< d 0)
                        (when (= 0 (cmp (list a b c d)))
                          (inc! count))
                        (loop3 (- d 1)))))
                  (loop2 (- c 1)))))
            (loop1 (- b 1)))))
      (loop0 (- a 1))))
  count)

(define (main args)
  (print (lag (x->integer (cadr args)))))

time gosh lag.scm 20007
738

real    0m15.154s
user    0m15.108s
sys     0m0.010s

• こんな入れ子のループを使うんじゃ、Cで書いたのと変わらない。
• amb かなにかで書き直したほうがいいかなぁ。速度が犠牲になりそうだけど。
• Haskell はすごいよ id:zyxwv:20070531
• Ruby で amb 使ってる。すごい。 id:mzp:20070531

• (追記) Cで書いたらどうなるよ。

#include <stdio.h>
#include <math.h>

int cmp (int a, int b, int c, int d, int n)
{
  int s = a * a + b * b + c * c + d * d;
  if (n == s) return 0;
  if (n < s) return 1;
  return -1;
}

int main (int argc, char **argv)
{
  int count = 0;
  int i,j,k,l;
  int n = 20007;
  for (i = (int) sqrt (n); i >= 0; i--) {
    if (cmp (i,0,0,0,n) == 1) continue;
    for (j = i; j >= 0; j--) {
      if (cmp (i,j,0,0,n) == 1) continue;
      for (k = j; k >= 0; k--) {
	if (cmp (i,j,k,0,n) == 1) continue;
	for (l = k; l >= 0; l--) {
	  if (cmp (i,j,k,l,n) == 0) count++;
	}
      }
    }
  }
  printf("%d\n", count);
  return 0;
}

time ./a.out
738

real    0m0.116s
user    0m0.114s
sys     0m0.002s

ぎゃふん。