Acme::Grep2D - Grep in 2 dimensions

Acme-Grep2D documentation Contained in the Acme-Grep2D distribution.

Index

Code Index:

NAME

Top

Acme::Grep2D - Grep in 2 dimensions

VERSION

Top

Version 0.01

SYNOPSIS

Top

    use Acme::Grep2D;

    my $foo = Acme::Grep2D->new(text => ??);
    ...

DESCRIPTION

Top

For testing another module, I needed the ability to grep in 2 dimensions, hence this module.

This module can grep forwards, backwards, up, down, and diagonally in a given text string. Given the text:

  THIST  T S
  .H  H H  II
  ..I II SIHTH
  ...SS    T  T

We can find all occurances of THIS.

Full Perl regexp is allowed, with a few limitations. Unlike regular grep, you get back (for each match) an array containing array references with the following contents:

  [$length, $x, $y, $dx, $dy, ??]

Operational note: there is one more argument at the end of the returned array reference (as indicated by ??). Don't mess with this. It's reserved for future use.

METHODS

Top

new

  $g2d = Acme::Grep2D->new(text => ??);

Constructor. Specify text pattern to be grepped (multiline, with newlines).

Example:

  my $text = <<'EOF';
  foobarf
  .o,,,o
  ,,o?f?fr
  <<,b ooa
  ##a#a ob
  @r@@@rbo
  ------ao
  ~~~~~~rf
  EOF

  $g2d = Acme::Grep2D->new(text => $text);

Now, our grep will have no problem finding all of the "foobar" strings in the text (see Grep or other more directional methods).

The author is interested in any novel use you might find for this module (other than solving newspaper puzzles).

Grep

  $g2d->Grep($re);

Find the regular expression ($re) no matter where it occurs in text.

The difference from a regular grep is that "coordinate" information is returned for matches. This is the length of the found match, x and y coordinates, along with directional movement information (dx, dy). It's easiest to use extract to access matches.

grep_hf

  @matches = $g2d->grep_hf($re);

Search text normally, left to right.

grep_hr

  @matches = $g2d->grep_hf($re);

Search text normally, but right to left.

grep_h

  @matches = $g2d->grep_h($re);

Search text normally, in both directions.

grep_vf

  @matches = grep_vf($re);

Search text vertically, down.

grep_vr

  @matches = grep_vr($re);

Search text vertically, up.

grep_v

  @matches = $g2d->grep_v($re);

Search text vertically, both directions.

grep_rlf

  @matches = $g2d->grep_rlf($re);

Search the R->L vector top to bottom.

grep_rlr

  @matches = $g2d->grep_rlr($re);

Search the R->L vector bottom to top.

grep_rl

  @matches = $g2d->grep_rlf($re);

Search the R->L both directions.

grep_lrf

  @matches = $g2d->grep_lrf($re);

Search the L->R top to bottom.

grep_lrr

  @matches = $g2d->grep_lrr($re);

Search the L->R bottom to top.

grep_lr

  @matches = $g2d->grep_lr($re);

Search the L->R both directions.

extract

  $result = $g2d->extract($info);

Extract pattern match described by $info, which is a single return from Grep. E.g.

  my @matches = $g2d->Grep(qr(foo\w+));
  map {
      print "Matched ", $g2d->extract($_), "\n";
  } @matches;

text

  $textRef = $g2d->text();

Return an array reference to our internal text buffer. This is for future use. Don't mess with the return, or bad things may happen.

AUTHOR

Top

X Cramps, <cramps.the at gmail.com>

BUGS

Top

Please report any bugs or feature requests to bug-acme-grep2d at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Acme-Grep2D. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc Acme::Grep2D

You can also look for information at:

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=Acme-Grep2D

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/Acme-Grep2D

* CPAN Ratings

http://cpanratings.perl.org/d/Acme-Grep2D

* Search CPAN

http://search.cpan.org/dist/Acme-Grep2D/

ACKNOWLEDGEMENTS

Top

Captain Beefheart and the Magic Band. Fast & bulbous. Tight, also.

COPYRIGHT & LICENSE

Top

Copyright 2009 X Cramps, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Acme-Grep2D documentation Contained in the Acme-Grep2D distribution. 
package Acme::Grep2D;

use warnings;
use strict;
use Data::Dumper;
use Perl6::Attributes;


our $VERSION = '0.01';



sub new {
    my ($class, %opts) = @_;
    my $self = \%opts;
    bless $self, $class;
    $.Class = $class;
    ./_required('text');
        ./_init();
    return $self;
}

# check for mandatory options
sub _required {
    my ($self, $name) = @_;
    die "$.Class - $name is required\n" unless defined $self->{$name};
}

# adjust dimensions to be rectangular, and figure out what's
# in there in all directions
sub _init {
    my ($self) = @_;
    my $text = $.text;
    my @text;
    
    # split on newlines, preserving them spatially
    while ((my $n = index($text, "\n")) >= 0) {
        my $chunk = substr($text, 0, $n);
        push(@text, $chunk);
        $text = substr($text, $n+1);
    }
    chomp foreach @text;

    my @len;
    push(@len, length($_)) foreach @text;
    my $maxlen = $len[0];
    my $nlines = @text;

    #determine max length of each string
    map {
        $maxlen = $len[$_] if $len[$_] > $maxlen;
    } 0..($nlines-1);

    # make all lines same length
    map {
        $text[$_] .= ' ' x ($maxlen-$len[$_]);
    } 0..($nlines-1);
    #print Dumper(\@text);

    my @diagLR;
    my @diagRL;
    my @vertical;
    my $x = 0;
    my $y = 0;
    my $max = $nlines;
    $max = $maxlen if $maxlen < $nlines;

    # find text along diagonal L->R
    for (my $char=0; $char < $maxlen; $char++) {
        my @d;
        $x = $char;
        my $y = 0;
        my @origin = ($x, $y);
        map {
            if ($y < $nlines && $x < $maxlen) {
                my $char = substr($text[$y], $x, 1);
                push(@d, $char) if defined $char;
            }
            $x++;
            $y++;
        } 0..$nlines-1;
        unshift(@d, \@origin);
        push(@diagLR, \@d) if @d;
    }

    for (my $line=1; $line < $nlines; $line++) {
        my @d;
        $x = 0;
        my $y = $line;
        my @origin = ($x, $y);
        map {
            if ($y < $nlines && $x < $maxlen) {
                my $char = substr($text[$y], $x, 1);
                push(@d, $char) if defined $char;
            }
            $x++;
            $y++;
        } 0..$nlines-1;
        unshift(@d, \@origin);
        push(@diagLR, \@d) if @d;
    }

    # find text along diagonal R->L
    for (my $char=0; $char < $maxlen; $char++) {
        my @d;
        $x = $char;
        my $y = 0;
        my @origin = ($x, $y);
        map {
            if ($y < $nlines && $x >= 0) {
                my $char = substr($text[$y], $x, 1);
                push(@d, $char) if defined $char;
            }
            $x--;
            $y++;
        } 0..$nlines-1;
        unshift(@d, \@origin);
        push(@diagRL, \@d) if @d;
    }

    for (my $line=1; $line < $nlines; $line++) {
        my @d;
        $x = $maxlen-1;
        my $y = $line;
        my @origin = ($x, $y);
        map {
            if ($y < $nlines && $x >= 0) {
                my $char = substr($text[$y], $x, 1);
                push(@d, $char) if defined $char;
            }
            $x--;
            $y++;
        } 0..$nlines-1;
        unshift(@d, \@origin);
        push(@diagRL, \@d) if @d;
    }

    # find text along vertical
    for (my $char=0; $char < $maxlen; $char++) {
        my @d;
        my @origin = ($char, $y);
        push(@d, substr($text[$_], $char, 1)) for 0..$nlines-1;
        unshift(@d, \@origin);
        push(@vertical, \@d);
    }

    # correct LR to make text greppable
    map {
        my ($coords, @text) = @$_;
        my $text = join('', @text);
        $_ = [$text, $coords];
    } @diagLR;

    # correct RL to make text greppable
    map {
        my ($coords, @text) = @$_;
        my $text = join('', @text);
        $_ = [$text, $coords];
    } @diagRL;

    # correct vertical to make text greppable
    map {
        my ($coords, @text) = @$_;
        my $text = join('', @text);
        $_ = [$text, $coords];
    } @vertical;
    $.diagLR   = \@diagLR;
    $.diagRL   = \@diagRL;
    $.vertical = \@vertical;
    $.maxlen = $maxlen;
    $.nlines = $nlines;
    $.text   = \@text;
}

# reverse a string
sub _reverse {
    my ($self, $text) = @_;
    my @text = split //, $text;
    return join '', reverse(@text);
}


sub Grep {
    my ($self, $re) = @_;
    my @matches;

    # find things "normally," like a regular grep
    push(@matches, ./grep_h($re));

        # find things in the L->R diagonal vector
        push(@matches, ./grep_lr($re));

    # find things in the R->L diagonal vector
    push(@matches, ./grep_rl($re));

        # find things in the vertical vector
        push(@matches, ./grep_v($re));

    return @matches;
}

sub _ref {
    my ($self, $ref) = @_;
    return \$ref if ref($ref) eq 'SCALAR';
    return \$ref->[0] if ref($ref) eq 'ARRAY';
}


sub grep_hf {
    my ($self, $re) = @_;
    my @matches;
    my $n = 0;
    # find things "normally," like a regular grep
    foreach (@{$.text}) {
        my $text = $_;
        while ($text =~/($re)/g) {
            push(@matches, [length($1), _start(\$text,$1), $n, 1, 0, \$_])
        }
        $n++;
    };
    return @matches;
}


sub grep_hr {
    my ($self, $re) = @_;
    my @matches;
    my $n = 0;
    # find things "normally," like a regular grep
    foreach (@{$.text}) {
        my $text = $_;
        $text = ./_reverse($text);
                while ($text =~/($re)/g) {
            push(@matches, 
                [length($1), length($text)-(_start(\$text,$1)+1), 
                $n, -1, 0, \$_]) 
        }
        $n++;
    };
    return @matches;
}


sub grep_h {
    my ($self, $re) = @_;
    my @matches;
    push(@matches, ./grep_hf($re));
        push(@matches, ./grep_hr($re));
    return @matches;
}



sub grep_vf {
    my ($self, $re) = @_;
    my @matches;
    # find things in the vertical vector
    foreach (@{$.vertical}) {
        my ($text, $coords) = @$_;
        my ($x, $y) = @$coords;
        push(@matches, [length($1), $x, _start(\$text, $1), 
            0, 1, \$_]) while ($text =~ /($re)/g);
    }
    return @matches;
}


sub grep_vr {
    my ($self, $re) = @_;
    my @matches;
    # find things in the vertical vector
    foreach (@{$.vertical}) {
        my ($text, $coords) = @$_;
        my ($x, $y) = @$coords;
        $text = ./_reverse($text);
                push(@matches, [length($1),$x, length($text)-_start(\$text, $1)-1,
                        0, -1, \$_]) while ($text =~ /($re)/g);
    }
    return @matches;
}


sub grep_v {
    my ($self, $re) = @_;
    my @matches;
    push(@matches, ./grep_vf($re));
        push(@matches, ./grep_vr($re));
    return @matches;
}


sub grep_rlf {
    my ($self, $re) = @_;
    my @matches;
    # find things in the R->L diagonal vector
    foreach (@{$.diagRL}) {
        my ($text, $coords) = @$_;
        my ($x, $y) = @$coords;
        while ($text =~ /($re)/g) {
            my $off = _start(\$text, $1);
            my $length = length($1);
            push(@matches, [$length, $x-$off, $off+$y, -1, 1, \$_]);
        }
    }
    return @matches;
}


sub grep_rlr {
    my ($self, $re) = @_;
    my @matches;
    # find things in the R->L diagonal vector
    foreach (@{$.diagRL}) {
        my ($text, $coords) = @$_;
        my ($x, $y) = @$coords;
        $text = ./_reverse($text);
                $x -= length($text);
                $y += length($text);
                $x++;
                $y--;
                while ($text =~ /($re)/g) {
            my $off = _start(\$text, $1);
            my $length = length($1);
            push(@matches, [$length, $x+$off, $y-$off, 1, -1, \$_]);
        }
    }
    return @matches;
}


sub grep_rl {
    my ($self, $re) = @_;
    my @matches;
    push(@matches, ./grep_rlf($re));
        push(@matches, ./grep_rlr($re));
    return @matches;
}


sub grep_lrf {
    my ($self, $re) = @_;
    my @matches;
    # find things in the L->R diagonal vector
    foreach (@{$.diagLR}) {
        my ($text, $coords) = @$_;
        my ($x, $y) = @$coords;
        while ($text =~ /($re)/g) {
            my $off = _start(\$text,$1);
            push(@matches, 
                [length($1), $x+$off, $off+$y, 1, 1, \$_]) 
        }
    }
    return @matches;
}


sub grep_lrr {
    my ($self, $re) = @_;
    my @matches;
    # find things in the L->R diagonal vector
    foreach (@{$.diagLR}) {
        my ($text, $coords) = @$_;
        my ($x, $y) = @$coords;
        $text = ./_reverse($text);
                while ($text =~ /($re)/g) {
            my $off = _start(\$text,$1);
            my $length = length($1);
            $x += length($text);
            $y += length($text);
            $x--;
            $y--;
            push(@matches, 
                [length($1), $x-$off, $y-$off, -1, -1, \$_]) 
        }
    }
    return @matches;
}


sub grep_lr {
    my ($self, $re) = @_;
    my @matches;
    push(@matches, ./grep_lrf($re));
        push(@matches, ./grep_lrr($re));
    return @matches;
}


sub extract {
    my ($self, $info) = @_;
    my ($length, $x, $y, $dx, $dy) = @$info;
    my @result;
    map {
        push(@result, substr($.text->[$y], $x, 1));
        $x += $dx;
        $y += $dy;
    } 1..$length;
    return join('', @result);
}

sub _start {
    my ($textRef, $one) = @_;
    return pos($$textRef) - length($one);
}


sub text {
    my ($self) = @_;
    return $.text;
}


1;