rectangle-ball.pl

rectangle-ball.pl

#!/usr/bin/env perl
use strict;
use warnings;

use feature qw/say/;
use Data::Dumper;

# @xtetsujiさんからの出題
# https://twitter.com/xtetsuji/status/1287259431822962689?s=20
# usege
# $ perl rectangle-ball.pl 3 6

# 引数チェック。なければ {y => 3, x => 6} で実行
my $pool_size = {};
if ( scalar(@ARGV) == 2 ) {
    $pool_size = { y => $ARGV[0], x => $ARGV[1] };
}
else {
    $pool_size = { y => 3, x => 6 };
}

my $ball = Ball->new( { pool => Position->new($pool_size) } );

my $max_step = 1000;    # 無限ループ対策のフールプルーフ

while (1) {
    say $ball->info();
    $ball->move();

    last if ( $ball->step() == $max_step );
}

# 座標クラス
package Position;
use Data::Dumper;

sub new {
    my $class = shift;
    my $argv  = shift;
    my ( $x, $y ) = ( $argv->{x}, $argv->{y} );
    my $self = bless { x => $x, y => $y }, $class;
}

sub x {
    my $self = shift;
    my $argv = shift;
    if ($argv) {
        $self->{x} += $argv;
    }
    return $self->{x};
}

sub y {
    my $self = shift;
    my $argv = shift;
    if ($argv) {
        $self->{y} += $argv;
    }
    return $self->{y};
}

sub update {
    my $self = shift;
    my $argv = shift;

    $self->x( $argv->{x} );
    $self->y( $argv->{y} );

    return $self;
}

# ボールクラス・・・責務が多すぎでは感
package Ball;
use Data::Dumper;

use constant {
    START_POSITION => Position->new( { y => 1, x => 1 } ),
    RIGHT_DOWN     => { y => 1, x => 1 },
    RIGHT_UP       => { y => -1, x => 1 },
    LEFT_DOWN      => { y => 1, x => -1 },
    LEFT_UP        => { y => -1, x => -1 },
};
use List::Util qw/min max/;

sub new {
    my $class     = shift;
    my $argv      = shift;
    my $goals     = $argv->{pool};
    my $step      = 0;
    my $direction = RIGHT_DOWN;      # 最初にボールが動く方向
    my $pos       = Position->new(
        {   x => START_POSITION->{x},
            y => START_POSITION->{y}
        }
    );                               # 初期位置
    my $obj = bless {
        pool => $argv->{pool},
        pos  => $pos,

        goals     => _add_goals($goals),
        direction => $direction,
        step      => 1,
    }, $class;
}

sub pos {
    my $self = shift;
    my $argv = shift;

    # TODO:引数あり
    return $self->{pos};
}

sub pool {
    my $self = shift;
    my $argv = shift;

    return $self->{pool};
}

sub info {
    my $self = shift;
    my ( $x, $y, $step ) = ( $self->pos->x, $self->pos->y, $self->step );

    return sprintf( '%3d:[y: %0d, x: %0d]', $step, $y, $x );
}

sub move {
    my $self = shift;

    $self->step(1);

    $self->pos->update( $self->direction );

    if ( $self->_is_arraive_at_the_goal() ) {
        say $self->info();
        say "goal";

        exit();
    }

    if ( $self->is_touch_the_wall() ) {
        $self->change_direction();
    }

}

sub _add_goals() {
    my $pool = shift;

    my $x_max = max( START_POSITION->{x}, $pool->{x} );
    my $x_min = min( START_POSITION->{x}, $pool->{x} );

    my $y_max = max( START_POSITION->{y}, $pool->{y} );
    my $y_min = min( START_POSITION->{y}, $pool->{y} );

    my $goals = [
        Position->new( { x => START_POSITION->x, y => START_POSITION->y } ),
        $pool,
        Position->new( { x => $x_max, y => $y_min } ),
        Position->new( { x => $x_min, y => $y_max } ),
    ];

    return $goals;
}

sub goals {
    my $self = shift;
    my $argv = shift;

    return $self->{goals};
}

sub _is_arraive_at_the_goal() {
    my $self = shift;

    for my $goal_pos ( @{ $self->goals } ) {

        if (   $self->pos->x == $goal_pos->x
            && $self->pos->y == $goal_pos->y )
        {
            return 1;
        }
    }
    return 0;

}

sub step {
    my $self = shift;
    my $argv = shift;
    if ($argv) {
        $self->{step} += $argv;
    }

    return $self->{step};
}

sub direction {
    my $self = shift;
    my $argv = shift;

    if ($argv) {
        $self->{direction} = $argv;
    }
    return $self->{direction};
}

sub is_touch_the_wall {
    my $self = shift;

    # 縦の壁
    if ( $self->_is_touch_vertical_wall() ) {
        return 1;
    }

    # 横の壁
    if ( $self->_is_touch_horizontal_wall() ) {
        return 1;
    }
    return 0;
}

sub _is_touch_vertical_wall {
    my $self = shift;

    if (   $self->pos->x == START_POSITION->x
        || $self->pos->x == $self->pool->x )
    {
        return 1;
    }
    return 0;
}

sub _is_touch_horizontal_wall {
    my $self = shift;

    if (   $self->pos->y == START_POSITION->y
        || $self->pos->y == $self->pool->y )
    {
        return 1;
    }
    return 0;

}

sub change_direction {
    my $self = shift;

    if ( $self->_is_touch_vertical_wall() ) {
        if ( $self->direction == RIGHT_DOWN ) {
            $self->direction(LEFT_DOWN);
        }
        elsif ( $self->direction == LEFT_DOWN ) {
            $self->direction(RIGHT_DOWN);
        }
        elsif ( $self->direction == RIGHT_UP ) {
            $self->direction(LEFT_UP);
        }
        elsif ( $self->direction == LEFT_UP ) {
            $self->direction(RIGHT_UP);
        }
        else {
            die;

        }
    }

    if ( $self->_is_touch_horizontal_wall() ) {
        if ( $self->direction == RIGHT_DOWN ) {

            $self->direction(RIGHT_UP);
        }
        elsif ( $self->direction == RIGHT_UP ) {
            $self->direction(RIGHT_DOWN);
        }
        elsif ( $self->direction == LEFT_DOWN ) {
            $self->direction(LEFT_UP);
        }
        elsif ( $self->direction == LEFT_UP ) {
            $self->direction(LEFT_DOWN);
        }
        else {
            die;
        }
    }
}

__END__
縦横の長さが与えられた長方形のビリヤード台がある。このビリヤード台は摩擦も無く、壁で理想的な反発を行うものとする。長さに関して、ボール1個分がちょうど入る正方形の辺の長さを1としてそれを基準とする。つまりビリヤード台はその正方形を1区画として集めた長方形となっている。ボールの座標は左上を (1,1) として、縦に下方向が x 軸の増加方向、横に右方向が y 軸の増加方向とする。
この時左上のコーナー（隅）から右下45度の角度でボールを打つ場合、ボールはどのような軌跡で跳ね返りを行い、4つのコーナーのどこに至るか。ここでコーナーに至った場合、そこに穴があり落ちる (GOALする) とする。また、ボールが特定の正方形の単位区画にちょうど入るたびにステップ数が増えるとした場合、初期左上の状態をステップ1とした場合、何ステップで穴に落ちるかも求めたい。
$ perl rectangle-ball.pl 3 6
rectangle: (3, 6)
1 (1, 1)
2 (2, 2)
3 (3, 3)
4 (2, 4)
5 (1, 5)
6 (2, 6)
7 (3, 5)
8 (2, 4)
9 (1, 3)
10 (2, 2)
11 (3, 1)
GOAL!