Find the shortest word in the English Language with: a b c d e f

[usemodperl]

_{Edit: Not going to edit this node because of replies but Eily noticed there is an extra single quote at the end of my port :-/}

This recent post in r/programming poses an interesting question for a bit of golf: "What is the shortest word in the English Language which contains: a b c d e f?" Some Junk™ code was posted to figure this out and my Perl version is a bit shorter. I know you perl better than me, if you do, and can see how else to do this:

The Junk Code:

sorted([w.strip() for w in open('/usr/share/dict/words', 'r').readline
+s()
if set(list('abcdef')).issubset(set(list(w.strip())))], key=lambda x: 
+len(x))

My Perl Port:

open$:,"</usr/share/dict/words";while(<$:>){next unless/(?=.*a)(?=.*b)
+(?=.*c)(?=.*d)(?=.*e)(?=.*f)/i;push@_,$_}@_=sort{length$a<=>length$b}
+@_'

For your convenience:

Print the list:

open$:,"</usr/share/dict/words";while(<$:>){next unless/(?=.*a)(?=.*b)
+(?=.*c)(?=.*d)(?=.*e)(?=.*f)/i;push@_,$_}print for sort{length$a<=>le
+ngth$b}@_

Print the word:

open$:,"</usr/share/dict/words";while(<$:>){next unless/(?=.*a)(?=.*b)
+(?=.*c)(?=.*d)(?=.*e)(?=.*f)/i;push@_,$_}for(sort{length$a<=>length$b
+}@_){print;last}

Compare length of Perl to Junk:

#!/usr/bin/perl -lw
use strict;

my $PERL = <<'PERL';
open$:,"</usr/share/dict/words";while(<$:>){next unless/(?=.*a)(?=.*b)
+(?=.*c)(?=
.*d)(?=.*e)(?=.*f)/i;push@_,$_}@_=sort{length$a<=>length$b}@_'
PERL

{ no strict;

$JUNK = <<JUNK;
sorted([w.strip() for w in open('/usr/share/dict/words', 'r').readline
+s()
if set(list('abcdef')).issubset(set(list(w.strip())))], key=lambda x: 
+len(x))
JUNK

print length $PERL, ' PERL: ', $PERL;
print length $JUNK, ' JUNK: ', $JUNK;
}

# I think junk could lose 4 spaces making it 148.
__END__
PERL: 144
JUNK: 152

Of course different versions of dict give different results...

[Eily]

The empty diamond with @ARGV lets (edit: not "let's") you win a few chars:

open$:,"</usr/share/dict/words";while(<$:>){...}
@ARGV="/usr/share/dict/words";while(<>){...}

Using the magic increment on a string (eg 'a'), you can have /$a/ search for the successive letters in the alphabet (also "push if" is shorter than "next unless; push"):

$a='a';$a++while/$a/;push@_,$_ if$a gt'f'
next unless/(?=.*a)(?=.*b)(?=.*c)(?=.*d)(?=.*e)(?=.*f)/i;push@_,$_

And I thought the sorting was too verbose, so I stored the matching words by length to begin with:

@ARGV="/usr/share/dict/words";while(<>){$a='a';$a++while/$a/i;push@{$_
+[length]},$_ if$a gt'f'}@_=map{$_?@$_:()}@_
open$:,"</usr/share/dict/words";while(<$:>){next unless/(?=.*a)(?=.*b)
+(?=.*c)(?=.*d)(?=.*e)(?=.*f)/i;push@_,$_}@_=sort{length$a<=>length$b}
+@_

That's 31 fewer chars than your version, not counting the extra ' in your perl code ;-)

A chomp might be needed somewhere though, adding at least 5 chars.

[jwkrahn]

push@{$_[length]},$_

push@{$_[y///c]},$_

map{$_?@$_:()}@_

map$_?@$_:(),@_

[Eily]

Yes, and I can remove three additional chars by using bareword a and f rather than strings:

@ARGV="/usr/share/dict/words";while(<>){$a='a';$a++while/$a/i;push@{$_
+[length]},$_ if$a gt'f'}@_=map{$_?@$_:()}@_
@ARGV="/usr/share/dict/words";while(<>){$a=a;$a++while/$a/i;push@{$_[y
+///c]},$_ if$a gt f}@_=map$_?@$_:(),@_

And who needs a path when perl can just guess? :P. @ARGV=</*/*/*/words>;while(<>){$a=a;$a++while/$a/i;push@{$_[y///c]},$_ if$a gt f}@_=map$_?@$_:(),@_ Which brings the count to 100 chars (including the \n)

[jwkrahn]

an interesting question for a bit of golf

Change:

next unless/(?=.*a)(?=.*b)(?=.*c)(?=.*d)(?=.*e)(?=.*f)/i;push@_,$_

To:

/a/i&/b/i&/c/i&/d/i&/e/i&/f/i&&push@_,$_

And you can save one character by using a bareword filehandle.

[haukex]

TIMTOWTDI :-)

next unless/(?=.*a)(?=.*b)(?=.*c)(?=.*d)(?=.*e)(?=.*f)/i;push@_,$_

# ==>
lc=~s/(.)(?=.*\1)//gr=~y/abcdef//<6||push@_,$_

# or, on Perls <5.14:
($b=lc)=~s/(.)(?=.*\1)//g;$b=~y/abcdef//<6||push@_,$_

Update: s/tr/y/, thanks Eily :-)

[QM]

Cheating a bit, but I have a generic script to read a dictionary, and execute arbitrary regexes or code blocks against it. Since I already have the dictionary in a nice format, in a default location, the command line looks like this:

w -r a -r b -r c -r d -r e -r f|perl -ple '$_=length($_)." $_"'|sort -
+n|head -1

But of course, w is rather long and generic, and will take a number of regexes or a single code block.

And this misses multiple words, if several are the same length. (I get "feedback" and "boldface" from my list, at length 8.)

Interestingly, adding "g" gives only 1 word, and doesn't require sorting: "blackfigured":

w -r a -r b -r c -r d -r e -r f -r g|perl -ple '$_=length($_)." $_"'

ETA: Using the codeblock form:

w -c '$_=shift;length if/a/&&/b/&&/c/&&/d/&&/e/&&/f/'|sort -n -k 3|hea
+d -1

(The output format is a bit different with codeblock, and must be sorted by field 3.)

[mr_mischief]

For golf purposes, the data usually isn't embedded in the code. Here's a not-too golfed 116 characters that is flexible enough to have you specify your dictionary file as the first argument.

$s=99;$c='abcdef';for(<>){chomp;$w=$_;$l=y///c;@m=grep{1+index$w,$_}sp
+lit//,$c;@m>5&&$s>$l||next;$s=$l;$n=$w}print$n

If we know already that we're looking for something shorter than ten characters, we can save one character right off the bat.

$s=9;

But wait, we're storing an array just to take a count of its elements later. We also know there's just the one newline after the word, so chomp wastes one. We can save some strokes there, too. 110:

$s=9;$c='abcdef';for(<>){chop;$w=$_;$l=y///c;(5<grep{1+index$w,$_}spli
+t//,$c)&&$s>$l||next;$s=$l;$n=$w}print$n

Speaking of storing things and referring to them later... 104:

$s=9;for(<>){chop;$w=$_;$l=y///c;(5<grep{1+index$w,$_}split//,'abcdef'
+)&&$s>$l||next;$s=$l;$n=$w}print$n

Sometimes you can drop characters by switching your control flow a bit. 103:

$s=9;for(<>){chop;$w=$_;$l=y///c;(5<grep{1+index$w,$_}split//,'abcdef'
+)&&$s>$l&&do{$s=$l;$n=$w}}print$n

Sometimes you can remove an operation by thinking a bit differently about your data. 101:

$s=9;for(<>){$w=$_;$l=y///c;(6<grep{1+index$w,$_}split//,"abcdef\n")&&
+$s>=$l&&do{$s=$l;$n=$w}}print$n

All of this, mind you, meets the exact spec of finding the shortest word rather than printing a sorted list of words. It's from scratch against that spec rather than deriving from the other solutions already presented. This is just a stab at describing the process of golfing down a solution that came to me from reading the spec. Notice I dropped 15 characters in 5 revisions from something that already had no whitespace, and this solution doesn't abuse the language too badly considering it's code golf. I'm sure someone can come along with some dirtier tricks and more magical parts of the language and get a shorter pure Perl solution.

[jdporter]

Some Junk™ code was posted

What is Junk code? And why the trademark symbol? Is that sarcastic?

[usemodperl]

You guys are amazing. I'm still freaking out about this thing Eily did with $a++while/$a/i and the length based array. I'll be studying this node for a very long time... Thanks for all the homework!

[Anonymous Monk]

The word, by the way, is "feedback."

[hippo]

Are you sure?

[mr_mischief]

I'm quite sure "What is the shortest English word that contains the letters a,b,c,d,e and f?" doesn't say "What is the shortest English word that contains only the letters a,b,c,d,e and f?"

[Anonymous Monk]

if the word isn't in Webster's, I would say that it isn't a proper answer. bedface is an industry term. However, the correct answer is fabdec, which is the name of my cat.