Coffee time quiz

perlmoth has asked for the wisdom of the Perl Monks concerning the following question:

"What word in the English language has 15 letters, none of which is repeated?"

This was the question on the blackboard in a local branch of a well-known purveyor of over-priced, burnt coffee, and if you knew the answer you could get a free latte. I though to myself "Perl could help find the answer to that", and I set about writing the following code:

#!/usr/bin/perl -w

use strict;
use diagnostics;

# open DICT, "/usr/dict/words";
open DICT, "/tmp/web2.txt";
my @words_of_15_letters;

while (<DICT>) {
  push @words_of_15_letters, $_ if /^.{15}$/;
}

print "Number of words found ", scalar @words_of_15_letters, "\n";

foreach my $word (@words_of_15_letters) {

  my %letter_count;
  my $repeat_found;

  foreach my $letter (split //, $word) {
    $letter_count{$letter}++;
  }

  foreach (keys %letter_count) {
    $repeat_found = 1 if $letter_count{$_} > 1;
  }

  print $word unless $repeat_found;
}
[download]

The first thing I found was that /usr/dict/words doesn't have the answer. It has too few words in it. I downloaded a dictionary file from puzzlers.org that had about 5 times more words in it.

This code finds the right answer, but I would like to know if anyone can improve it. It seems much more long-winded than it needs to be. Is there any way of making it more succinct? In particular, is there a way to check for repeated letters in the pattern match?

Comment on Coffee time quiz Select or Download Code

Replies are listed 'Best First'.
Re: Coffee time quiz by ChemBoy (Priest) on Oct 22, 2002 at 20:32 UTC
If we combine the suggestion above with a little knowledge of Perl builtins and command-line options, we get `perl -lne 'print if length == 15 and not /(.).\1/' /usr/share/dict/w +ords` [download] Well, you asked for succinct... <grin> Update: added auto-chomp (shame, shame). If God had meant us to fly, he would never* have given us the railroads. --Michael Flanders	[reply] [d/l]
Re: Re: Coffee time quiz by sauoq (Abbot) on Oct 22, 2002 at 21:19 UTC
++ChemBoy. Very nice. Golfed: `perl -pe '$_ x=length==16&&!/(.).*\1/'` [download] -sauoq "My two cents aren't worth a dime.";	[reply] [d/l]
Re: Re: Re: Coffee time quiz by locked_user mtve (Deacon) on Oct 29, 2002 at 14:17 UTC
golf! `perl -pe '$_ x=/^.{15}$/-/(.).*\1/'`
Re: Re: Coffee time quiz by thelenm (Vicar) on Oct 22, 2002 at 20:42 UTC
I really like this clever solution. :-) Of course, 15 needs to be 16 because of the newline. Or you could use the -l option instead. -- Mike `-- just,my${.02}`	[reply]
Re: Re: Coffee time quiz by Anonymous Monk on Oct 24, 2002 at 10:42 UTC
A Good one ...... Anandatirtha	[reply]
Re: Coffee time quiz by zigdon (Deacon) on Oct 22, 2002 at 20:22 UTC
How about this: `print $word unless $word =~ /(.).*?\1/;` [download] -- Dan	[reply] [d/l]
Re: Coffee time quiz by Bilbo (Pilgrim) on Oct 22, 2002 at 20:16 UTC
You could shorten it very slightly by combining the two loops at the end into something like: `foreach my $letter (split //, $word) { $letter_count{$letter}++; $repeat_found = 1 if ($letter_count{$letter} > 1); }` [download]	[reply] [d/l]
Re: Coffee time quiz by Zaxo (Archbishop) on Oct 22, 2002 at 20:30 UTC
`sub nonrepeating { my $word = shift \|\| $_; my %chars; @chars{ split( //, $word)} = (); length($word) == keys %chars; } my @solutions; while (<DICT>) { chomp; push @solutions, $_ if length() == 15 and nonrepeating(); }` [download] This uses the short-circuit behavior of and to only do the expensive `nonrepeating()` test if the word has fifteen characters. As a matter of style, some will object to the $_ default in `sub nonrepeating`, but I think pronouns fit right in there. This saves some memory over yours at runtime since only actual solutions are pushed. After Compline, Zaxo	[reply] [d/l]
Re: Coffee time quiz by runrig (Abbot) on Oct 22, 2002 at 20:26 UTC
`for my $word (@words) { print "$word\n" if no_repeat($word); } sub no_repeat { my $word = shift; my %letter_cnt; $letter_cnt{$_}++ && return for split '', $word; 1; }` [download]	[reply] [d/l]
Re: Coffee time quiz by fglock (Vicar) on Oct 22, 2002 at 20:58 UTC
This is a faster way to count unique characters, using /s (Squash duplicate replaced characters) option of "tr": `$_ = "abcdeaacde"; $_=join ("",sort split //); tr/a-z//s; print length;` [download] output: 5	[reply] [d/l]
Re^2: Coffee time quiz by Aristotle (Chancellor) on Oct 22, 2002 at 21:35 UTC
Much shorter: `print scalar keys %{{map{(lc)x2} /(.)/sg}};` In a oneliner: `perl -lne'print if !grep $_ != 15, length, scalar keys %{{map{(lc)x2} /(.)/sg}}'` I find two words: dermatoglyphics uncopyrightable There'd probably be a few more in a larger list. Makeshifts last the longest.	[reply] [d/l] [select]
Re: Coffee time quiz by robobunny (Friar) on Oct 22, 2002 at 20:40 UTC
so what is "the right answer" according to the affor-not-mentioned coffee shop? i get 7 possibilities from my word file.	[reply]
Re: Re: Coffee time quiz by perlmoth (Hermit) on Oct 22, 2002 at 21:00 UTC
I don't know what word the coffee shop was looking for. It was several months before I got around to writing the code to find the answer, and by that time the question had long gone. I never did get the free latte, merely my curiosity satisfied. My word file only gives one answer: "dermatoglyphics".	[reply]
Re: Coffee time quiz by rir (Vicar) on Oct 22, 2002 at 23:40 UTC
I invite the good golfers come back to this with an output requirement like: `answer anothe goldie 379 tested, 3 found` [download] Update: output the words, a count of those words, and a count of words of the required length. Seeing how the logic and readability changes, or not, would would be interesting.	[reply] [d/l]
Re: Re: Coffee time quiz by BrowserUk (Patriarch) on Oct 23, 2002 at 02:12 UTC
Building on ChemBoy's and sauoq's brilliant work... 'scuse the double quotes. `E:\Perl\lib>perl -pe "END{print qq($. tested, $Â£ found)};$_ x=(leng +th==16&&!/(.).\1/)and$Â£++" <words.txt Admiralty House Bishop Auckland blasting powder cloth-measuring cloth-spreading dermatoglyphics ditch sunflower wheat-producing 633293 tested, 8 found E:\Perl\lib>` [download] And yes, I know my words list has some stupid "words" in it:^) Cor! Like yer ring! ... HALO* dammit! ... 'Ave it yer way! Hal-lo, Mister la-de-da. ... Like yer ring!	[reply] [d/l]