smarter chooser

4 files changed, 238 insertions, 2 deletions

diff --git a/lib/GridFiller.pm b/lib/GridFiller.pm
index 022b14b..2b92285 100644
--- a/lib/GridFiller.pm
+++ b/lib/GridFiller.pm
@@ -4,7 +4,7 @@ use namespace::autoclean;
 use GridFiller::Types qw(GridT WordListT);
 use GridFiller::Status;
 use GridFiller::Result;
-use GridFiller::Chooser;
+use GridFiller::Chooser::Smarter;
 use Carp;
 
 with 'MooseX::Log::Log4perl';
@@ -26,7 +26,7 @@ sub fill {
 
     my $status = GridFiller::Status->new({grid => $self->grid, words => $self->words});
     my $result = GridFiller::Result->new({source_grid => $self->grid});
-    my $chooser = GridFiller::Chooser->new({status => $status});
+    my $chooser = GridFiller::Chooser::Smarter->new({status => $status});
 
     while ($status->unfilled() && $status->has_next_word()) {
         my $word = $status->get_next_word();
diff --git a/lib/GridFiller/Chooser.pm b/lib/GridFiller/Chooser.pm
new file mode 100644
index 0000000..66e13b9
--- /dev/null
+++ b/lib/GridFiller/Chooser.pm
@@ -0,0 +1,23 @@
+package GridFiller::Chooser;
+use Moose;
+use namespace::autoclean;
+use GridFiller::Status;
+use GridFiller::Constants ':all';
+use Carp;
+
+with 'MooseX::Log::Log4perl';
+
+has status => (
+    isa => 'GridFiller::Status',
+    is => 'ro',
+    required => 1,
+    handles => {
+        grid => 'grid_status',
+    },
+);
+
+sub find_place_for {
+    croak "unimplemented";
+}
+
+1;
diff --git a/lib/GridFiller/Chooser/Random.pm b/lib/GridFiller/Chooser/Random.pm
new file mode 100644
index 0000000..7b86d55
--- /dev/null
+++ b/lib/GridFiller/Chooser/Random.pm
@@ -0,0 +1,95 @@
+package GridFiller::Chooser::Random;
+use Moose;
+use namespace::autoclean;
+use GridFiller::Constants ':all';
+use Carp;
+
+extends 'GridFiller::Chooser';
+
+sub find_place_for {
+    my ($self,$word) = @_;
+
+    my $dir = int(rand(2)) ? $HORIZONTAL : $VERTICAL;
+
+    my $length = length $word;
+
+    my @ret;
+
+    if ($dir == $HORIZONTAL) {
+        @ret = $self->_find_place_horiz($length);
+        @ret = $self->_find_place_vert($length) unless @ret;
+    }
+    else {
+        @ret = $self->_find_place_vert($length);
+        @ret = $self->_find_place_horiz($length) unless @ret;
+    }
+
+    return @ret;
+}
+
+sub _find_place_horiz {
+    my ($self,$length) = @_;
+
+    my $rows = scalar @{$self->grid};
+    my $col;
+
+    for my $row (0..$rows-1) {
+        $col = $self->_find_in_row($row,$length);
+        return ($col,$row,$HORIZONTAL) if defined $col;
+    }
+    return;
+}
+
+sub _find_place_vert {
+    my ($self,$length) = @_;
+
+    my $cols = scalar @{$self->grid->[0]};
+    my $row;
+
+    for my $col (0..$cols-1) {
+        $row = $self->_find_in_col($col,$length);
+        return ($col,$row,$VERTICAL) if defined $row;
+    }
+    return;
+}
+
+{
+my %symbols=(
+    $NOTHING => ' ',
+    $BLACK => 'X',
+    $WHITE => 'O',
+);
+
+sub _do_find {
+    my ($self,$str,$length) = @_;
+
+    my ($skip) = ($str =~ m{^ (.*?) (?: X{$length} | O{$length} ) }x);
+
+    $self->log->debug(defined $skip ? " skip <$skip>" : " nope");
+
+    return length($skip) if defined $skip;
+    return;
+}
+
+sub _find_in_row {
+    my ($self,$row,$length) = @_;
+
+    my $str = join '',map { $symbols{$_} } @{$self->grid->[$row]};
+
+    $self->log->debug("row $row = $str");
+
+    return $self->_do_find($str,$length);
+}
+
+sub _find_in_col {
+    my ($self,$col,$length) = @_;
+
+    my $str = join '',map { $symbols{$_->[$col]} } @{$self->grid};
+
+    $self->log->debug("col $col = $str");
+
+    return $self->_do_find($str,$length);
+}
+}
+
+1;
diff --git a/lib/GridFiller/Chooser/Smarter.pm b/lib/GridFiller/Chooser/Smarter.pm
new file mode 100644
index 0000000..814e930
--- /dev/null
+++ b/lib/GridFiller/Chooser/Smarter.pm
@@ -0,0 +1,118 @@
+package GridFiller::Chooser::Smarter;
+use Moose;
+use namespace::autoclean -also => [qw(maxfirst)];
+use GridFiller::Constants ':all';
+use List::Util 'reduce';
+use Carp;
+
+extends 'GridFiller::Chooser';
+
+sub maxfirst {
+    return reduce { $a->[0] > $b->[0] ? $a : $b } @_;
+}
+
+sub find_place_for {
+    my ($self,$word) = @_;
+
+    my $length = length $word;
+
+    my @candidates;
+
+    push @candidates, $self->_find_places_horiz($length);
+    push @candidates, $self->_find_places_vert($length);
+
+    return unless @candidates;
+
+    my $ret = maxfirst @candidates;
+
+    shift @$ret;
+
+    return @$ret;
+}
+
+sub _find_places_horiz {
+    my ($self,$length) = @_;
+
+    my $rows = scalar @{$self->grid};
+    my ($col,$space);
+
+    my @ret;
+
+    for my $row (0..$rows-1) {
+        ($space,$col) = $self->_find_in_row($row,$length);
+        push @ret, [$space,$col,$row,$HORIZONTAL] if defined $space;
+    }
+    return @ret;
+}
+
+sub _find_places_vert {
+    my ($self,$length) = @_;
+
+    my $cols = scalar @{$self->grid->[0]};
+    my ($row,$space);
+
+    my @ret;
+
+    for my $col (0..$cols-1) {
+        ($space,$row) = $self->_find_in_col($col,$length);
+        push @ret,[$space,$col,$row,$VERTICAL] if defined $space;
+    }
+    return @ret;
+}
+
+{
+my %symbols=(
+    $NOTHING => ' ',
+    $BLACK => 'X',
+    $WHITE => 'O',
+);
+
+sub _do_find {
+    my ($self,$str,$length) = @_;
+
+    my $rx = qr{\G .*?
+                (?:
+                    X{$length} (?<tail>X*)
+                |
+                    O{$length} (?<tail>O*)
+                ) }x;
+
+    pos($str)=undef;
+
+    my @ret;
+
+    while ($str =~ m{$rx}gc) {
+        my $tail=length $+{tail};
+        my $skip=pos($str)-$length-$tail;
+
+        push @ret,[$tail,$skip];
+        $self->log->debug(" skip $skip tail $tail")
+    }
+
+    return unless @ret;
+
+    return @{maxfirst(@ret)};
+}
+
+sub _find_in_row {
+    my ($self,$row,$length) = @_;
+
+    my $str = join '',map { $symbols{$_} } @{$self->grid->[$row]};
+
+    $self->log->debug("row $row = $str");
+
+    return $self->_do_find($str,$length);
+}
+
+sub _find_in_col {
+    my ($self,$col,$length) = @_;
+
+    my $str = join '',map { $symbols{$_->[$col]} } @{$self->grid};
+
+    $self->log->debug("col $col = $str");
+
+    return $self->_do_find($str,$length);
+}
+}
+
+1;