格子点の列挙 in PostScript DouKaku?

格子点の列挙

二次元平面上の格子点(X,Y座標がともに整数の点)を、原点から近い順に列挙してください。

同じ距離の点はどういう順番でも構いませんが、可能であればX軸に一番近い第一象限の点から原点を中心として反時計回りの順に列挙してください。列挙の方法は、1行に一つの点の、X,Y座標を出力することとします。

サンプル出力

0, 0
1, 0
0, 1
-1, 0
0, -1
1, 1
-1, 1
1, -1
-1, -1
2, 0

最低でも1000件まで列挙できることを確認してください。また「反時計回り」の条件も満たしている場合は、1000番目の頂点が何かも併せて答えてください。

このお題はかもさんの投稿を元にしています。ご協力ありがとうございました。

Perl がなかったので。力技。

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));
}

post comment

Posted feedbacks - PostScript

力技で.. Bubble Sort したら遅かったので無理矢理 Quick Sort を実装。まだ荒削りですが。

%!PS

/CompareVal { % [R X Y Theta] [R2 X2 Y2 Theta2 ] CompareXY  integer
    2 copy 0 get exch 0 get sub
    dup 0 eq
    {
        pop
        3 get exch 3 get sub
    } {
        exch pop exch pop
    } ifelse
    neg
} bind def

/QSort { %  [Array] /CompareFunction  QSort  [Array']
    cvx
    1 index 0 get
    0 3 index length 1 sub
    % [Array] Comp pivot l r
    {
        2 copy ge { exit } if 
        {
            2 copy ge { exit } if
            4 index 1 index get 3 index 5 index
            exec 0 lt { exit } if
            1 sub
        } loop
        2 copy ne {
            4 index 1 index get
            5 index exch 3 index exch put
            exch 1 add exch
        } if
        {
            2 copy ge { exit } if
            4 index 2 index get 3 index 5 index exec 0 gt { exit } if
            exch 1 add exch
        } loop
        2 copy ne {
            4 index 2 index get
            5 index exch 2 index exch put
            1 sub
        } if
    } loop
    4 index 2 index 4 index put 
    1 index 1 gt {
        4 index 0 3 index getinterval
        4 index QSort pop
    } if
    % [Array] Comp pivot l r
    4 index length 1 index 2 add gt {
        4 index dup length 3 index sub 1 sub  3 index 1 add exch getinterval
        4 index
        QSort pop
    } if
    pop pop pop pop
} bind def


/GenLattice { % N  GenLattice  [ [r^2 x1 y1 angle] ... ]
    [ exch
    2 div sqrt 1 add cvi
    dup neg exch 1 exch
    % [ -X0 1 X0 
    3 copy {
        % [ -X0 1 X0 Y
        4 copy pop {
            % [ -X0 1 X0 Y X
            2 copy [ 3 1 roll
            % [ -X0 1 X0 Y X  [ Y X
            2 copy dup mul exch dup mul add sqrt
            3 1 roll
            2 index 0 eq { 0 } { 2 copy atan } ifelse
            ]
            % [ -X0 1 X0 Y X  [ r^2 Y X theta ]
            6 1 roll pop
            % [ [] -X0 1 X0 Y 
        } for
        pop
    } for
    pop pop pop ]
} bind def

/DisplayLatticePoints { % N  DisplayLatticePoints  -
    dup GenLattice /CompareVal QSort
    0 1 4 -1 roll
    {
        1 index exch get aload pop pop
        10 string cvs print (, ) print =
        pop
    } for
    pop
} bind def

1000 DisplayLatticePoints

DouKaku?

格子点の列挙

Posted feedbacks - PostScript

Index

Feed

Other

Link

Pathtraq