Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • Perhaps using a nested array that indexes one character at a time would help. Each array would have a counter (to count the number of words that matched this far in) and 26 refs to additional arrays. There would be 3 starting arrays - one counts words that begin with a substring, one counts words that end with a (reversed) substring, and one counts words that contain a substring. The following does this. (However, this code does not tell you which words can be used to provide a traversal - the reversible routine would have to be augmented somewhat to return possible matches by following all paths below the matching points.)
    my @head, @tail, @middle;

    sub add_counts {
        my $ref = shift;
        while( @_ ) {
            my $charindex = shift;
            $ref =
                defined $ref->[charindex]
                ? $ref->[$charindex]
                : ($ref->[$charindex] = []);
            ++$ref->[0];
        }
    }

    my %mapchar = (
        a=>1,
        b=>2,
        # ...
        z=>26 );

    sub charlist {
        my $word = shift;
        map { $mapchar{$_} } ($word =~ m/(.)/g);
    }

    sub mapword {
        my @chars = charlist shift;
        add_counts( \@head, @chars );
        add_counts( \@tail, reverse @chars );
        pop @chars;
        shift @chars;
        while( @chars ) {
            add_counts( \@middle, @chars );
            shift @chars;
        }
    }

    sub maxtrav {
        my $ref = shift;
        my $count = 0;
        while( $char = shift ) {
            last unless defined $ref->[$char];
            ++$count;
        }
        $count;
    }

    sub reversible {
        my @chars = charlist shift;
        my $hlen = maxtrav( \@head, @chars );
        my $tlen = maxtrav( \@tail, reverse @chars );
        my $mlen = maxtrav( \@middle, @chars );
        ($hlen+$tlen) >= @chars || $mlen >= @chars;
    }