#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use Data::Dumper;
use Time::HiRes qw( tv_interval gettimeofday );
use Memoize; memoize('eval_table'); #memoize('minimax');

my ($value_2, $value_3, $value_4, $max) = (1, 10, 1000, 10_000);
my %color = ( 'none' => 0, 'white' => 1, 'black' => 2, 'both' => 3);

my ($width,$height) = (7,7);
my $max_depth = 9;
my $cpu = $color{'white'};

GetOptions("depth=i" => \$max_depth,
           "width=i" => \$width,
           "height=i"=> \$height,
           "cpu=i"   => \$cpu
        ) or die qq{
Usage: ./c4player [--depth=$max_depth] [--width=$width] [--height=$height] [--cpu=$cpu]

depth: how deep the cpu will search
width, height: board dimension
cpu: }.(join ", ",map{ "$_:$color{$_}" }keys %color).qq{

};

our $eval_score;
my ($table, $minimax_solution, @move_order);
my ($score_pattern, $win_pattern,@add_stone_patterns, $table_full_pattern);

setup();
play();
exit 0;

sub setup {
    @move_order = ();
    push @move_order, int $width / 2 if $width % 2;
    push @move_order, int $width/2 + $_ - (1-$width%2), int $width/2 - $_
        for 1..$width/2;

    $table = join "\n", map { $color{'none'} x $width } 1..$height;

    my ($dleft, $dright) = ($width-1, $width+1);

    $win_pattern = qr/([$color{black}$color{white}])
                (?:.{$dleft}(?:.(?:\1.{$width}\1|
                .\1.{$dright}\1.).{$width}\1|\1.{$dleft}\1.{$dleft}\1)
                |\1\1\1)/xs;

    my $m_height = $height - 1;
    $add_stone_patterns[$_] = qr/^.{$_}(?:.{$dright}){0,$m_height}\K$color{none}/s
        for 0..$width-1;

    $table_full_pattern = qr/^[^$color{none}]{$width}/;

    my %pieces;
    for (glob "{$color{none},$color{white},$color{black}}" x 4) {
	my ($w,$b) = eval "y/$color{white}//,y/$color{black}//";
        my $var = '$eval_score';
           if($w == 2 && $b == 0) { $var .= "+=$value_2" }
        elsif($w == 3 && $b == 0) { $var .= "+=$value_3" }
        elsif($w == 0 && $b == 2) { $var .= "-=$value_2" }
        elsif($w == 0 && $b == 3) { $var .= "-=$value_3" }
        else {  next  }
    
        my ($i,$j,$k,$l) = split //;
        $pieces{$i}{$j}{$k}{$l} = $var;
    }

    my $lambda; $lambda = sub { #($hashref, $separator)
        return !ref $_[0] ? "(?{$_[0]})(*F)" :
        join '|', map { "$_[1]$_(?:".$lambda->($_[0]->{$_},$_[1]).')' } keys %{$_[0]}
    };

    my $p = join '|', map { join '|',
        "(?:$_(?:".$lambda->($pieces{$_}, ''          ). '))',
        "(?:$_(?:".$lambda->($pieces{$_}, ".{$dleft}" ). '))',
        "(?:$_(?:".$lambda->($pieces{$_}, ".{$width}" ). '))',
        "(?:$_(?:".$lambda->($pieces{$_}, ".{$dright}"). '))'
    } keys %pieces;

    use re 'eval';
    $score_pattern = qr/$p/s;
}

sub play {
    my $color = $color{'white'};
    my $p;
    while(1) {
        if($cpu == $color or $cpu == $color{'both'}) {
            $p = cpu_play($table, $color);
        }else{
            print "[$color]: "; chomp($p = <>);
        }
        next unless $p < $width && $table =~ s/$add_stone_patterns[$p]/$color/;
        print "$table\n\n";

        print "$color won\n" and last if $table =~ $win_pattern;
        print "draw\n" and last if $table =~ $table_full_pattern;

        $color = $color{'both'} - $color; # swap
    }
}

sub cpu_play {
    my ($table, $color) = @_;
    $minimax_solution = -1;
    my $t0 = [gettimeofday];
    my $v = minimax($table, $color, 0, -$max, $max);
    print "CPU[$color] got $minimax_solution(score $v) in ".tv_interval($t0, [gettimeofday])."s\n";
    return $minimax_solution;
}

sub minimax {
    my ($table, $color, $depth, $alpha, $beta) = @_;
    
    return $1 == $color ? $max : -$max if $table =~ $win_pattern;
    return 0 if $table =~ $table_full_pattern;
    return eval_table($table, $color) if $depth == $max_depth;

    my $n_color = $color{'both'} - $color; # swap color
    my $new_beta = $beta;

    for (@move_order) {
        my $child = $table;
        next unless $child =~ s/$add_stone_patterns[$_]/$color/;

        my $value = -minimax($child, $n_color, $depth+1, -$new_beta, -$alpha);

        $value = -minimax($child, $n_color, $depth+1, -$beta, -$alpha)
            if $alpha < $value && $value < $beta && $_ != $move_order[0];
 
        if($alpha < $value) {
            $minimax_solution = $_ if $depth == 0;
            $alpha = $value;
        }
        return $alpha if $alpha >= $beta;
        $new_beta = $alpha + 1;
    }
    return $alpha;
}

sub eval_table {
    my ($table, $color) = @_;
    $eval_score = 0;
    $table =~ $score_pattern;
    return $color == $color{'white'} ? $eval_score : -$eval_score;
}