帰ってきたネコブログ

そろそろ、この本(*1)に載ってるパラメータ以外のカオスを描画したいので、
そのパラメータを探してみようと思う。

use v5.14;
use strict;
use warnings;

use Imager;
use List::Util qw/max sum shuffle/;
use Time::Piece;

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

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 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 ( $dst_dir, $prefix, $src, $th, $curve ) = @_;

    my $n = 4096;
    my @palette = map {
        my $val = ($_ - 1) / ($n - 1);
        Imager::Color->new( hue => 0, v => $val, s => 0.0 );
    } 1..$n;

    my $img = render_image( $src, $th, $curve, \@palette );

    my $dst_file = sprintf( '%s/%s_curve_%.1f.png', $dst_dir, $prefix, $curve );
    $img->write( file => $dst_file ) or die $img->errstr;
    say 'wrote: ', $dst_file;
}

sub calc_source {
    my ( $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!';
            return undef;
        }
        else {
            ( $x0, $y0 ) = ( $x, $y );
        }

        my ( $u, $v ) = (
            ($x * $scale) + $u0,
            $v0 - ($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!';

    return \@result;    
}

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

my $t = localtime;
my $dst_dir = $t->strftime( '%Y%m%d_%H%M%S' );

if ( -e $dst_dir ) {
    die "$dst_dir is already exists!";
}

if ( not mkdir($dst_dir) ) {
    die "cannot mkdir: $dst_dir";
}

my $log_file = join( '/', $dst_dir, $dst_dir . '.txt' );
say 'logfile: ', $log_file;

my @params = map {
    ($_ - 200) / 200;
} 0..400;

foreach ( 1..100 ) {
    my $prefix = ($0 =~ s/\.pl//r) . $_;

    @params = shuffle @params;
    my @args = (
        $params[0] * 1.0,
        $params[1] * 0.1,
        $params[2] * 2.0,
        $params[3] * 1.0
    );
    #my @args = ( -1.0, 0.05, 2.275, -0.5 );

    my $src = calc_source( $n, @args, 150.0 );
    next if not $src;

    my $val_max = int( max(@{$src}) );
    next if (scalar(@{$src}) * 0.01) < $val_max;

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

    my $highlight = scalar(@{$src}) * 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--;
        last if $th <= 0;
    }

    if ( 0 < $th ) {
        #say 'th: ', $th, ', sum: ', sum(@hist[$th..$val_max]);
        say 'params: ', join( ',', @args );

        open( my $fh, '>>', $log_file ) or die "$log_file cannot open for append.";
        print $fh ($prefix, ' : ', join(',', @args));
        print $fh "\n";
        close( $fh );

        save_image( $dst_dir, $prefix, $src, $th, 0.5 );
    }
}

発散したり、ヒストグラムを見て、
絵にならなそうなのを除くと、かなり絞られる。
上記のコードは100回ほど計算してるけど、
多くても5個くらいしか使えそうなパラメータは残らない。
なので、1,000回くらい計算して取捨選択するのがオススメ。

今回のポイントとしては、
このスクリプトは何回も実行して、たくさんファイルを生成するので、
実行する度にフォルダを作成して、その中にファイルを保存するようにした。

と言う訳で、見つけたパラメータから1枚。
a = -0.365, b = -0.086, c = 1.77, d = 0.52

おしまい。

(*1) CによるカオスCG (Information & computing (78))

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