ltrposhz-2.pl

#!/usr/bin/perl -w

# Count character position letter occurrence (frequency) in input.
# First argument is length of word (# of letters) to look for.
# Remaining arguments are input files, or stdin.
# Assumes one word per input line, ASCII, English.
# Excludes words containing non-letter characters (contractions like: can't)
# Excludes words containing capital letters (proper names like: Alice)
# Does not attempt to exclude plurals.
# Was written for Wordle but has applications for other word games.

use strict;
use warnings;
use English;
use feature qw( say );

# goldie = Goldilocks = just right (words the right length)

my $words = 0;   # count of words/lines seen
my $goldies = 0; # count of words of correct length seen
my @slot;        # letter position slots, each a hash, key=letter, val=count
my $all = 0;     # slot zero counts occurrences in any/all positions

my $goldlen = shift;
die "missing argument: word length" if not defined $goldlen;
die "argument must be integer word length" if ($goldlen =~ m/[^0-9]/);

 WORD: while (<>) {

    chomp;
    $words++;
    next WORD if length != $goldlen;
    next WORD if m/[^A-Za-z]/; # exclude impure words (non-letter chars)
    next WORD if m/[A-Z]/; # exclude capital letters == proper names
    $goldies++;

    # for each position slot, count that letter into the hash
    my @letters = split //;
    my $cur = 1; # starts at one, counts up for each LETTER
    LETTER: foreach my $letter (@letters) {
        $slot[$all]{$letter}++; # $all = zero for every LETTER
        $slot[$cur]{$letter}++;
        $cur++;
        }
    }

# output - totals
say "words=$words goldies=$goldies";

# output - table
# each row gives a letter and its counts
# first field/column is the letter for that row
# second column is the count for each letter in any slot
# remaining columns are the counts for the letter in their slots

# column headers
print "LTR\tALL\t";
# column numbers, starting at one, as zero is "ALL"
for (my $cur = 1; $cur <= $goldlen; $cur++) { print "$cur\t"; }
print "\n";

# run through alphabet, and then each slot
foreach my $letter ('a'..'z') {
    print $letter, "\t";
    # since @slot uses slot 0 for ALL, we can just iterate the array
    for (my $cur = 0; $cur <= $goldlen; $cur++) {
        my $count = $slot[$cur]{$letter};
        $count = 0 if not defined $count;
        print $count, "\t";
        }
    print "\n";
    }

# EOF