帰ってきたネコブログ

前回は描画に時間が掛かっていたので、
リファクタリングをしつつ、描画時の処理を高速化してみました。

use v5.14;
use strict;
use warnings;

use Imager;
use List::Util qw/max sum/;

use constant WIDTH => 600;
use constant HEIGHT => 600;

use constant SCALE_X => 180;
use constant SCALE_Y => 180;

sub f {
    my ( $aa, $bb, $cc, $xx, $yy ) = @_;
    my $x2 = $xx * $xx;
    my $y2 = $yy * $yy;
    return ($aa * ($x2 + $y2)) + ($bb * $xx * ($x2 - (3.0 * $y2))) + $cc;
}

sub gen_palette {
    my ( $n, $hue0, $dh ) = @_;

    return map {
        my $val = ($_ - 1) / ($n - 1);
        my $hue = $hue0 + ($val * $dh);

        $val *= 2.0;
        if ( $val <= 1.0 ) {
            Imager::Color->new( hue => $hue, v => $val, s => 1.0 );
        }
        elsif ( $val <= 2.0 ) {
            Imager::Color->new( hue => $hue, v => 1.0, s => (2.0 - $val) );
        }
        else {
            Imager::Color->new( hue => $hue, v => 1.0, s => 0.0 );
        }
    } 1..$n;
}

sub render_image {
    my ( $src, $th, $curve, $palette ) = @_;

    my $img = Imager->new(
        xsize => WIDTH, ysize => HEIGHT, channels => 3 );

    my $n = scalar( @{$palette} );
    my @dst = map {
        my $i = int( (($_ / $th) ** $curve) * ($n - 1) );
        $palette->[ ($n <= $i) ? ($n - 1) : $i ];
    } @{$src};

    my $iy = 0;
    while ( my @line = splice(@dst, 0, WIDTH) ) {
        $img->setscanline( y => $iy, pixels => \@line );
        $iy++;
    }

    return $img;
}

sub save_image {
    my ( $prefix, $src, $th, $hue0, $dh0, $step ) = @_;

    my @dh_list = ( 0 );
    foreach ( 0..2 ) {
        push @dh_list, $dh0 + ($step * $_);
        push @dh_list, -1 * ($dh0 + ($step * $_));
    }

    foreach my $dh ( @dh_list ) {
        my $curve = 0.6;
        my @palette = gen_palette( 4096, $hue0, $dh );
        my $img = render_image( $src, $th, $curve, \@palette );

        my $dst_file = sprintf('%s_%d_%d.png', $prefix, $hue0, $dh);
        $img->write( file => $dst_file ) or die $img->errstr;
        say 'wrote: ', $dst_file;
    }
}

sub calc_main {
    my ( $prefix, $n, $a0, $b0, $c0, $d0, $scale ) = @_;

    my ( $u0, $v0 ) = ( WIDTH / 2, HEIGHT / 2 );
    my @result = ();
    push @result, (map { 0; } 1..WIDTH) for 1..HEIGHT;

    my ( $x00, $y00 ) = ( 0.1, 0.1 );
    my ( $x0, $y0 ) = ( $x00, $y00 );
    my ( $x, $y ) = ( 0.0, 0.0 );

    printf( "\rprogress: %5.1f%%", 0 );
    for (my $i=0; $i<$n; $i++) {
        my $tmp = f( $a0, $b0, $c0, $x0, $y0 );
        $x = ($tmp * $x0) + ($d0 * (($x0 * $x0) - ($y0 * $y0)));
        $y = ($tmp * $y0) - (2.0 * $d0 * $x0 * $y0);

        #printf( "(x, y) = (%6.3f, %6.3f)\n", $x, $y );

        if ( 300 < (abs($x) + abs($y)) ) {
            say 'divergence!';
            ( $x0, $y0 ) = ( $x00, $y00 );
        }
        else {
            ( $x0, $y0 ) = ( $x, $y );
        }

        my ( $u, $v ) = (
            ($x * SCALE_X * $scale) + $u0,
            $v0 - ($y * SCALE_Y * $scale)
        );

        if ( 0 < $u and $u < (WIDTH - 1) and 0 < $v and $v < (HEIGHT - 1) ) {
            foreach ( -0.75, -0.25, +0.25, +0.75 ) {
                $result[ (int($v - 0.25) * WIDTH) + int($u + $_)] += 1;
                $result[ (int($v + 0.25) * WIDTH) + int($u + $_)] += 1;
                $result[ (int($v + $_) * WIDTH) + int($u - 0.25)] += 1;
                $result[ (int($v + $_) * WIDTH) + int($u + 0.25)] += 1;
            }
        }

        printf( "\rprogress: %5.1f%%", 100.0 * ($i / $n) );
    }
    print( "\n" );
    say 'calclated!';

    my $val_max = int( max(@result) );
    my @hist = map { 0; } 0..$val_max;
    $hist[int($_)]++ for @result;

    my $highlight = scalar(@result) * 0.00005;
    #say 'highlight: ', $highlight;

    my $th = $val_max - 1;
    while ( sum(@hist[$th..$val_max]) < $highlight ) {
        #say 'th: ', $th, ', sum: ', sum(@hist[$th..$val_max]);
        $th--;
    }
    
    say 'th: ', $th, ', sum: ', sum(@hist[$th..$val_max]);

    #                        $src, $th, $hue0, $dh0, $step
    save_image( $prefix, \@result, $th,   -10,   80,    20 );
    save_image( $prefix, \@result, $th,    60,   60,    20 );
    save_image( $prefix, \@result, $th,   120,   60,    10 );
    save_image( $prefix, \@result, $th,   180,   60,    10 );
}

local $| = 1;
my $n = $ARGV[0] // 100000;
say "N = $n";

calc_main( 'bbb1', $n, -1.0, 0.05, 2.275, -0.5, 0.8 );
calc_main( 'bbb2', $n,  1.0, 0.0, -1.9, 0.4, 1.0 );
calc_main( 'bbb3', $n,  1.0, 0.0, -2.25, 0.2, 1.0 );
calc_main( 'bbb4', $n, -1.0, 0.1, 1.6, -0.8, 1.0 );

今回から描画の処理時間が気にならなくなったので、
パラメータの組み合わせを数パターン用意して描画するようにしました。
それと、進捗表示を行う処理も追加しました。

描画処理の高速化の主な内容は、
1ピクセルずつhueを指定して色を作成していたのを、
あらかじめパレットを作成してテーブル引きで済むようにしました。
setpixelからsetscanlineを使うようにしたことで少しは改善されましたが、
前述の変更に比べると微々たる改善だった気がします。

$ perl aaa.pl 8000000

おしまい。

カテゴリー: Perl, コンピューター by ネコ on 2016年02月02日 | タグ: Imager > カオス > メモ