wordrank.pl

#!/usr/bin/perl

use strict;
use warnings;

my (@charval,%charval);
my $file_charval = '.\wordrank.txt';
my $file_output = '.\wordrank_out.txt';
my @wordlen = (5,8);
my $cutoff = 1000;
my $caprange = qr/^[n]/i;
my @wordlist;

if (-f $file_charval) {
    open CHARVAL, '<', $file_charval;
    chomp(@charval = <CHARVAL>);
    close CHARVAL;
    foreach (@charval) {
        my ($key,$val) = split;
        $charval{$key} = $val;
    }
}
else { print "Error: Values file was not found.\n"; exit; }

sub uniqchars {
    # http://www.perlmonks.org/?node_id=239649
    my $txt = join('', sort(split //,shift));
    $txt =~ s/(.)\1+/$1/g;
    return $txt;
}

sub wordrank {
    my $word = shift;
    my @char = split(//,$word);
    my $rank = 0;
    foreach (@char) {
        if (defined($charval{$_})) { $rank += $charval{$_}; }
        #else { print "Warning: Found a character without a value: '$_', skipping it.\n"; }
    }
    return $rank;
}


while (<>) {
    chomp;
    $_ = lc($_);
    $_ =~ s/ij/Y/g;
    if (length($_) < $wordlen[0] or length($_) > $wordlen[1] or substr($_,0,1) !~ $caprange) { next; }
    my $input = $_;
    my $uncapped = substr($input,1);
    my $output = wordrank(uniqchars($uncapped)).",$input,$uncapped,".uniqchars($uncapped);
    push @wordlist, $output;
}

@wordlist = reverse sort {
    (split(/,/,$a))[0] <=> (split(/,/,$b))[0];
} @wordlist;

my @filtered;
OUTER: for (my $i = 0; $i <= $cutoff; $i++) {
    my $record = $wordlist[$i];
    my $pattern = (split(/,/,$record))[3];
    my %letters;
    foreach (split(//,$pattern)) { $letters{$_} = 1; }
        INNER: for (my $j = ($i + 1); $j <= $cutoff; $j++) {
        my $match_record = $wordlist[$j];
        my $match_pattern = (split(/,/,$match_record))[3];
        foreach (split(//,$match_pattern)) {
            if (defined($letters{$_})) { next INNER; }
        }
            my @first = split(/,/,$record);
            my @second = split(/,/,$match_record);
            my $sum = $first[0] + $second[0];
            push @filtered, $sum . '|' . join(',',@first) . '|' . join(',',@second);
        next OUTER;
    }
}
@filtered = reverse sort {
    (split(/\|/,$a))[0] <=> (split(/\|/,$b))[0];
} @filtered;

open OUT, '>', $file_output;
foreach (@filtered) {
    my $sum = (split(/\|/,$_))[0];
    my @first = split(/,/,(split(/\|/,$_))[1]);
    my @second = split(/,/,(split(/\|/,$_))[2]);
    my $output = "$first[1] ($first[0]) + $second[1] ($second[0]) = $sum";
    print OUT "$output\n";
}