#! /usr/bin/perl -w
#

my $usage = <<EoF;
Print all spellings of words that can be spelled using only chemical
element symbols.

Usage:
    chem-element-words [words] [options]

Options include
 -D     include D for deuterium in the alphabet.
 -sys   check all words in /usr/dict/words or /usr/share/dict/words
 -sl    show the length of each word numerically
 -sm    show the multiplicity,
        i.e. the number of different ways the word can be spelled.
 -lc    show only one spelling per word, and convert it to lower case.
 -mm M  show only words with multiplicity at least M.
 -ml L  show only words with length at least L.
 -use F use file-list F as the dictionary [can be used multiple times].
 -list  display the element symbols in alphabetical order
 -h     show this message (and immediately exit).

If F is of the form of filenames separated by colons, we use the first
one that is available (and not the others).

You can also specify zero or more words on the command line.  This is
especially useful for words that are not in the dictionary.  If no
such words are specified, and no user dictionaries are specified, the
default is to turn on -sys.  Conversely, the explicit -sys option is
useful if you have a few words that you want to check /in addition/ to
the dictionary words.

Output:  The output is sorted by length of word.  The multiplicity is
shown with an \@ sign.

Examples:

:; chem-element-words coin
COIN COIn CoIN CoIn

:; chem-element-words -mm 13 -sl -sm -lc | sort -nr
24@ 17 inconspicuousness
24@ 15 consciousnesses
20@ 10 concubines
16@ 15 concessionaires
16@ 13 nonalcoholics
15@ 13 wisconsinites
15@ 12 wisconsinite
13@  8 nosiness
13@  7 casinos
EoF

use strict;
use Symbol;

my @elements = ('H', 'He', 'Li', 'Be', 'B', 'C', 'N', 'O', 'F', 'Ne',
'Na', 'Mg', 'Al', 'Si', 'P', 'S', 'Cl', 'Ar', 'K', 'Ca', 'Sc', 'Ti',
'V', 'Cr', 'Mn', 'Fe', 'Co', 'Ni', 'Cu', 'Zn', 'Ga', 'Ge', 'As', 'Se',
'Br', 'Kr', 'Rb', 'Sr', 'Y', 'Zr', 'Nb', 'Mo', 'Tc', 'Ru', 'Rh', 'Pd',
'Ag', 'Cd', 'In', 'Sn', 'Sb', 'Te', 'I', 'Xe', 'Cs', 'Ba', 'La', 'Ce',
'Pr', 'Nd', 'Pm', 'Sm', 'Eu', 'Gd', 'Tb', 'Dy', 'Ho', 'Er', 'Tm',
'Yb', 'Lu', 'Hf', 'Ta', 'W', 'Re', 'Os', 'Ir', 'Pt', 'Au', 'Hg', 'Tl',
'Pb', 'Bi', 'Po', 'At', 'Rn', 'Fr', 'Ra', 'Ac', 'Th', 'Pa', 'U', 'Np',
'Pu', 'Am', 'Cm', 'Bk', 'Cf', 'Es', 'Fm', 'Md', 'No', 'Lr', 'Rf',
'Db', 'Sg', 'Bh', 'Hs', 'Mt', 'Ds', 'Rg', 'Cn');

sub read_elements{

  my $didsome = 0;
  if (@elements == 0){
    my $home = $ENV{'HOME'}
      || die "no \$HOME variable in the environment?\n";
    my $ifn = $home . '/physics/periodic-table/p-trends.csv';
    my $inch = Symbol::gensym;
    open($inch, "<", $ifn)
         || die "Unable to open elements file '$ifn'\n";

    my $junk = <$inch>;           # skip header
    $junk = <$inch>;              # skip neutron
    while (my $line = <$inch>){
      chomp $line;
      my @stuff = split(',', $line, 4);
      if ($didsome) {
        print ", ";
      }
      print "'", $stuff[2], "'";
      $didsome++;
    }
    print "\n";
    exit 0;
  }

  my %map = ();
  foreach my $key (@elements) {
    $map{lc $key} = $key;
  }

  return %map;
}

my %map = ();

sub checksym{
  my ($right, $len) = @_;
  if (length($right) < $len){
    return '';
  }
  my $lcelem = lc substr($right, 0, $len);
  if (exists $map{$lcelem}){
    if (my $foo = checkit($map{$lcelem}, substr($right, $len))){
      return $foo;
    }
  }
  return '';
}

sub multiply{
  my $left = shift @_;
  my @rslt = ();
  foreach my $right (@_){
    push @rslt, $left . $right;
  }
  return @rslt;
}

# returns a listref
sub checkit {
  my ($left, $right) = @_;
  if ($right eq '') {
    return [$left];
  }
  my @rslt = ();
  if (my $foo = checksym($right, 1)){
    push @rslt, multiply ($left, @$foo);
  }
  if (my $foo = checksym($right, 2)){
    push @rslt, multiply ($left, @$foo);
  }
  return [@rslt];
}

## Modify this line as necessary to include the
## location of your dictionary.  Actually it doesn't
## have to be a dictionary per se;  it could be a list
## of names or other words, one per line.
my $sysdict = "/usr/dict/words:/usr/share/dict/words";

main:{

  my $limit = 0;
  my $tolower = 0;
  my $show_mp = 0;
  my $show_length = 0;
  my $min_mp = 0;
  my @todo = ();
  my @dictlist = ();
  %map = read_elements();
  my %seen = ();

  my @args = @ARGV;
  while (@args) {
    my $arg = shift @args;
    if (0) {}
    elsif ($arg eq '-h'){
      print $usage;
      exit(0);
    }
    elsif ($arg eq '-ml'){
      if (!@args) {
        die "Option '$arg' requires an argument.\n";
      }
      $limit = shift @args;
    }
    elsif ($arg eq '-lc'){
      $tolower++;
    }
    elsif ($arg eq '-sm'){      # show the multiplicity numerically
      $show_mp++;
    }
    elsif ($arg eq '-sl'){      # show the length numerically
      $show_length++;
    }
    elsif ($arg eq '-sys'){
      push @dictlist, $sysdict;
    }
    elsif ($arg eq '-D'){
      $map{'d'} = 'D';
    }
    elsif ($arg eq '-list') {
      my @stuff = sort keys %map;
      while (@stuff) {
        printer: for (my $ii = 0; $ii < 20; $ii++) {
          my $xx = shift @stuff || last printer;
          if (!$tolower) {
            $xx = $map{$xx};
          }
          printf("%-2s ", $xx);
        }
        print "\n";
      }
##      print join(' ', @stuff), "\n";
    }
    elsif ($arg eq '-use'){
      if (!@args) {
        die "Option '$arg' requires an argument.\n";
      }
      push @dictlist, shift @args;
    }
    elsif ($arg eq '-mm'){
      if (!@args) {
        die "Option '$arg' requires an argument.\n";
      }
      $min_mp = shift @args;
    }
    elsif ($arg =~ m'^-') {
      die "Unrecognized option '$arg'\n";
    }
    else {
      push @todo, $arg;
    }
  }

  my @spelled = ();

  foreach my $word (@todo) {
    my $found = checkit('', lc($word));
    if (@$found){
      push @spelled, $found;
    }
  }

  if (@dictlist == 0 && @todo == 0) {
    push @dictlist, $sysdict;
  }

  my $inch = Symbol::gensym;
  filer: foreach my $dict (@dictlist) {
    my @alternatives = split(':', $dict);
    opener: {
      foreach my $ifn (@alternatives){
        open($inch, "<", $ifn) && last opener;
      }
      if (@alternatives == 1) {
        print STDERR "Unable to open dictionary: $dict\n";
      } else {
        my $all = join(' | ', @alternatives);
        print STDERR "Unable to open any dictionary:\n$all\n";
      }
      close $inch;
      next filer;
    }

    liner: while (my $line = <$inch>){
      chomp $line;
      if ($line eq '') {
        next liner;
      }
      my $lcline = lc $line;
      if (exists $seen{$lcline}) {
        ## print STDERR "Skipping '$lcline'\n";
        next liner;
      }
      $seen{$lcline} = 1;
      my $found = checkit('', $lcline);
      if (@$found){
        push @spelled, $found;
      }
    }
    close $inch;
  }

  my @sorted = sort {length(@$b[0]) <=> length(@$a[0])} @spelled;
  foreach my $row (@sorted){
    if (length(@$row[0]) >= $limit
    && @$row >= $min_mp) {
      if ($show_mp){
        my $multiplicity = @$row;
        printf ("%2d@ ",  $multiplicity);
      }
      if ($show_length) {
        printf ("%2d ",  length(@$row[0]));
      }
      my $didsome = 0;
      rower: foreach my $item (@$row){
        if ($tolower) {
          $item = lc $item;
        }
        if ($didsome) {
          print ' ';
        }
        print $item;
        $didsome++;
        if ($tolower) {
          last rower;
        }
      }
      print "\n";
    }
  }
}