格子点の列挙
Perl がなかったので。力技。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | use strict;
my $PI = atan2(1, 1) * 4;
my $MAXR = int(sqrt(1000 / $PI) + sqrt(2) + 0.5);
my @res = ();
for (my $i = 0; $i <= $MAXR; $i++) {
for (my $j = 0; $j <= $MAXR; $j++) {
my $r = sqrt($i * $i + $j * $j);
push(@res, [$i, $j, $r, atan2($j, $i)]);
($i != 0) && push(@res, [-$i, $j, $r, atan2($j, -$i)]);
($j != 0) && push(@res, [$i, -$j, $r, atan2(-$j, $i) + 2 * $PI]);
($i * $j != 0) && push(@res, [-$i, -$j, $r, atan2(-$j, -$i) + 2 * $PI]);
}
}
foreach my $p (sort {($a->[2] <=> $b->[2]) || ($a->[3] <=> $b->[3])} @res) {
printf("%3d, %3d\n", splice(@{$p}, 0, 2));
}
|
Posted feedbacks - Scheme
無駄が多いですが、普通に解いてみました。 ところで、反時計回りだとサンプルの出力は以下のようになるべきでは? 0, 0 1, 0 0, 1 -1, 0 0, -1 1, 1 -1, 1 -1, -1 1, -1 2, 0 ※(1, -1)と(-1, -1)が逆のはず。 ちなみに1,000番目は -8, 16 です。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | (use srfi-1)
(use srfi-42)
(use math.const)
(define (make-point-list n)
(let ((a (ceiling->exact (/ (sqrt (* 2 n)) 2))))
(list-ec (: x (- a) (+ a 1)) (: y (- a) (+ a 1))
(make-rectangular x y))))
(define (sort-point-list lst)
(define (%angle z)
(let1 t (angle z)
(if (< t 0)
(+ (* 2 pi) t)
t)))
(sort lst (lambda (z1 z2)
(let ((r1 (magnitude z1))
(r2 (magnitude z2)))
(if (= r1 r2)
(< (%angle z1) (%angle z2))
(< r1 r2))))))
(define (lattice-point-list n)
(for-each (lambda (z)
(format #t "~d, ~d~%"
(inexact->exact (real-part z))
(inexact->exact (imag-part z))))
(take (sort-point-list (make-point-list n)) n)))
;; (lattice-point-list 1000)を実行すると答えが出ます
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | (use srfi-1)
(define (test n)
(take (stable-sort (append-map (lambda (x)
(append-map (lambda (y)
(cond
((and (zero? x) (zero? y))
(list (cons x y)))
((zero? x)
(list (cons x y)
(cons y x)
(cons (- y) x)
(cons x (- y))))
((zero? y)
(list (cons x y)
(cons y x)
(cons (- x) y)
(cons y (- x))))
((eq? x y)
(list (cons x y)
(cons (- y) x)
(cons (- x) (- y))
(cons y (- x))))
(else
(list (cons x y)
(cons y x)
(cons (- y) x)
(cons (- x) y)
(cons (- x) (- y))
(cons (- y) (- x))
(cons y (- x))
(cons x (- y))))))
(iota (+ x 1))))
(iota (+ 1 (inexact->exact (ceiling (* (sqrt 2) (quotient (inexact->exact (ceiling (sqrt n))) 2)))))))
(lambda (p0 p1)
(< (+ (expt (car p0) 2) (expt (cdr p0) 2))
(+ (expt (car p1) 2) (expt (cdr p1) 2))))) n))
(for-each print (test 1000))
|
ご指摘のとおりです。 反時計回りに何枚目のピザカットかを保存するようにしました。 これならatan使ったほうがいいでしょう。 ピザカット戦略はろくなことがないと、うちの祖母も言ってました。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | (use srfi-1)
(define (test n)
(define R (+ 1 (inexact->exact (ceiling (* (sqrt 2) (quotient (inexact->exact (ceiling (sqrt n))) 2))))))
(take (stable-sort (append-map (lambda (y)
(append-map (lambda (x)
(cond
((and (zero? x) (zero? y))
(list (list x y 0)))
((zero? x)
(list (list x y 0)
(list y x 2)
(list (- y) x 4)
(list x (- y) 6)))
((zero? y)
(list (list x y 0)
(list y x 2)
(list (- x) y 4)
(list y (- x) 6)))
((eq? x y)
(list (list x y 1)
(list (- y) x 3)
(list (- x) (- y) 5)
(list y (- x) 7)))
(else
(list (list x y 0)
(list y x 1)
(list (- y) x 2)
(list (- x) y 3)
(list (- x) (- y) 4)
(list (- y) (- x) 5)
(list y (- x) 6)
(list x (- y) 7)))))
(iota (- R y) y)))
(iota R))
(lambda (p0 p1)
(let ((r0 (+ (expt (car p0) 2) (expt (cadr p0) 2)))
(r1 (+ (expt (car p1) 2) (expt (cadr p1) 2))))
(if (= r0 r1)
(< (caddr p0) (caddr p1))
(< r0 r1))))) n))
(for-each (lambda (x)
(print (take x 2)))
(test 1000))
|
0≦x,y≦√(n/2) の範囲に限って列挙してから、xy軸ごとの対称性を利用する。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | (use srfi-1)
(define (test n)
(define R (inexact->exact (ceiling (* (sqrt 2)
(quotient
(inexact->exact (ceiling (sqrt n)))
2)))))
(define h (make-hash-table 'eq?))
(for-each (lambda (y)
(for-each (lambda (x)
(hash-table-push! h (+ (expt x 2) (expt y 2)) (cons x y)))
(iota R 1)))
(iota (+ R 1) R -1))
(for-each (lambda (key)
(hash-table-update! h key (lambda (x)
(append
x
(map (lambda (p)
(cons (- (cdr p)) (car p)))
x)
(map (lambda (p)
(cons (- (car p)) (- (cdr p))))
x)
(map (lambda (p)
(cons (cdr p) (- (car p))))
x)))))
(hash-table-keys h))
(take (acons 0 0 (append-map cdr (sort (hash-table-map h cons)
(lambda (p0 p1)
(< (car p0) (car p1))))))
n))
(for-each print (test 1000))
|
1. bufにはソート済みの点が入っていて、 距離n以上の点はまだ追加される可能性があります。 （距離n未満の点は追加される可能性がないので出力しても良い) 2. bufが空になるか、n未満の距離の点が無くなったら、 bufに(-n,-n)...(-n,n)...(n,n)...(n,-n)...と辺上の点を追加します。 これらの点で一番距離が近い物はnとなります。 bufは距離と角度でソートし、nは一つ増やします。 という感じで。 1000番目は(-8 16)になります。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | (use util.match)
(use srfi-42)
(define pi (atan 0 -1))
(define point
(let ((buf '((0 0 0 0)))
(n 1))
(define (dist x y)
(sqrt (+ (* x x) (* y y))))
(define (deg x y)
(let1 d0 (atan y x) (if (negative? d0) (+ d0 (* pi 2)) d0)))
(define cmp (match-lambda* (((dis1 deg1 . _) (dis2 deg2 . _))
(if (= dis1 dis2) (< deg1 deg2) (< dis1 dis2)))))
(define (points)
(append (append-ec (: i (- 1 n) n) `((,i ,n) (,i ,(- n))
(,n ,i) (,(- n) ,i)))
`((,n ,n) (,(- n) ,n) (,n ,(- n)) (,(- n) ,(- n)))))
(define (fetch-p)
(set! buf (sort!
(append buf
(map (match-lambda ((x y)
(list (dist x y) (deg x y) x y)))
(points)))
cmp))
(inc! n))
(lambda ()
(when (or (null? buf) (< n (caar buf))) (fetch-p))
(pop! buf))))
(define (main args)
(dotimes (i 1000)
(print (cddr (point)))))
|
かも
#3421()
Rating0/2=0.00
同じ距離の点はどういう順番でも構いませんが、可能であればX軸に一番近い第一象限の点から原点を中心として反時計回りの順に列挙してください。 列挙の方法は、1行に一つの点の、X,Y座標を出力することとします。
サンプル出力
最低でも1000件まで列挙できることを確認してください。 また「反時計回り」の条件も満たしている場合は、1000番目の頂点が何かも併せて答えてください。
このお題はかもさんの投稿を元にしています。ご協力ありがとうございました。
1 reply [ reply ]