rhymeThis

#So, I've had two *fantastic* margaritas, one *lucious* mojito, and two glasses of straight up rum-on-the-rocks. My girlfriend has a hankerin' for words that rhyme with Linux commands...so here ya go.

#Interactive pasteable paste of a bourne shell session employing Soundex and
# Perl to find command-line executables that rhyme with each other
#Requires: GNU/Linux, gcc, bash, perl5, and Internet egress and creates a new script named
# rhymeThis.pl which has modes to create forward and reverse lookup tables that map
#  words<==>sounds.

# The default mode accepts a word as an argument and returns a sorted list of rhymes

# TODO
# * parameterize library name
# * automatically generate lookup tables
# * accept multiple words and weight results by intersecting pronunciation

#generate a library of words from all unique commands on this GNU/Linux system
:; compgen -A function -abck|sort -u >./compgen.out

#lookup a command in the library
# output looks like 'head'
:; grep "^head" ./compgen.out

#download the "DoubleMetaphone" phonetic encoding software, which is based on Soundex, and
# inform your current shell about its location
:; { curl -sL cpanmin.us | perl - --local-lib=~/perl5 local::lib Text::DoubleMetaphone; } && eval \
    $(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)

#use DoubleMetaphone to generate a forward lookup table mapping each command in the library as a
# whole as well as its vowel-delimited suffix to the primary and secondary phonetic encodings
#  (I'd use the trailing phoneme instead if I knew how)
:; cat<<\HERE > ./rhymeThis.pl && chmod -c +x ./rhymeThis.pl && ./rhymeThis.pl cmd2code < ./compgen.out > ./rhymeThis.fwd
#!/usr/bin/perl
use Text::DoubleMetaphone qw(double_metaphone);
use strict;
my $mode = shift;
my %modes =
  (
    'cmd2code' => \&cmd2code,
    'code2cmd' => \&code2cmd,
  );
if (!$modes{$mode}) {
  &pretty($mode);
} else {
  $modes{$mode}->();
}
sub cmd2code() {
  while (<STDIN>) {
    chomp;
    my($rhyme) = my($cmd) = lc($_);
    $rhyme =~ s/.*([aeiou][^aeiou]+)$/$1/;
    my($first, $second) = double_metaphone($cmd);
    my($third, $fourth) = double_metaphone($rhyme);
    print "$cmd,$rhyme,$first,$second,$third,$fourth\n";
  };
};

HERE

#lookup a word in the fwd table
# output looks like 'head,ad,HT,,AT,'
:; grep "^head" ./rhymeThis.fwd

#the lookup table isn't really useful since it only gives us a pronunciation for the word we lookup, so let's add a subroutine to map each phonetic code in the fwd table to all of the commands that have the same sound
:; cat<<\HERE >> ./rhymeThis.pl && ./rhymeThis.pl code2cmd < ./rhymeThis.fwd > ./rhymeThis.rev
sub code2cmd() {
  my (%commands,%encodings);
  while (<STDIN>) {
    chomp;
    my($command,$rhyme,$first,$second,$third,$fourth) = split(/,/);
    my(@encodings) = ($first,$second,$third,$fourth);
    $commands{$command} = \@encodings;
  };
  foreach my $command (keys %commands) {
    foreach my $encoding (@{$commands{$command}}) {
      unless (!$encoding) {
        no strict 'refs';
        $encodings{$encoding} = \@$encoding;
        push(\@$encoding,$command);
      };
    };
  };
  foreach my $encoding (sort keys %encodings) {
    print "$encoding:\t";
    my (%uniqCmds) = map { $_ => 1 } @{$encodings{$encoding}};
    foreach my $command (sort keys %uniqCmds) {
      print $command . ", ";
    };
    print "\n";
  };
};

HERE

#lookup a word in the reverse table
# output looks like 'HT:     head,'
:; grep "head," ./rhymeThis.rev|tail -1

#some sounds have numerous matches so the results are visually noisy, so this returns a formatted result
:; cat<<\HERE >> ./rhymeThis.pl
sub pretty() {
  open revTable,"./rhymeThis.rev" or die "Reverse lookup table not found. $!";
  my (@matches,@rhymes);
  while (<revTable>) {
    next unless m/$_[0]/;
    chomp;
    $_ =~ s/^[^:]+:\t(.*)/$1/;
    $_ =~ s/\s+//g;
    push(@matches,split(/,/));
  }
  close revTable;
  my (%uniqMatches) = map { scalar reverse($_) , 1 } @matches;
  foreach (reverse sort keys %uniqMatches) {
    push(@rhymes,scalar reverse($_));
  }
  foreach (@rhymes) {
    printf("%48s\n",$_);
  }
}

HERE

#give it a whirl
# output is like
# …
#                                          parted
#                           popcon-largest-unused
#                                            psed
#                                             sed
#                                           shred
#                                             red
#                                     _rl_enabled
#                      landscape-is-cloud-managed
#                                              ed
# …

# find other commands that rhyme with any command on  this computer
:;./rhymeThis.pl head

# find commands on this computer that rhyme with any english word
:; cat<<\HERE > ./soundcode && chmod -c +x ./soundcode
perl -MText::DoubleMetaphone='double_metaphone' -e '@codes = double_metaphone($ARGV[0]);foreach (@codes) { print "$_\n"; }' $1|grep -f - ./rhymeThis.fwd
HERE

#say this to find sounds in the fwd lookup table that match an arbitrary english word
:; ./soundcode head