in reply to "Countdown" (golf)

This progarm has been running for many years, over 20 I think.While I do not watch it on a regular basis, I have watched it quite a bit.

The rules are you can only use the letters given and you can only use them as many times as they appear on the board.

Given that I dont think any solution so far actually solve the problem correctly. Also the question was to only list those which are of the longest length.

Here is my solution of 112

my @letters = qw(d u n s c a e y t);
open(D,"/usr/share/dict/words") or die $!;

print f(@letters);

sub f {
#        1         2         3         4         5
#234567890123456789012345678901234567890123456789012345
my%h;$h{$_}++for@_;my@b;push @{$b[length]},$_ for grep{
#    6        7         8         9         0         1
#78901234567890123456789012345678901234567890123456789012
my%g=%h;$g{$_}--for/./g;!grep{$_<0}values%g}<D>;@{$b[-1]}
}

[download]

But I am sure someone will shorten it

Replies are listed 'Best First'.
Re: Re: "Countdown" (golf)
by dragonchild (Archbishop) on Nov 30, 2001 at 22:31 UTC
    Modifying blakem's solution to do the longest yields 93 characters with 
    @_=sort@_;$"='?';push@{$,[length]},$_ for grep{(join'',sort split//)=~
+m!^$/@_?$!}<D>;@{pop@,}

    [download]

    Update: 92 characters. 

    @_=sort@_;$"='?';push@{$,[length]},$_ for grep{(join'',sort split//)=~
+m!$/@_?$!}<D>;@{pop@,}

    [download]

    Update2: 89 characters. 

    @_=sort@_;$"='?';push@{$,[length]},$_ for grep{(join'',sort/./sg)=~m!$
+/@_?$!}<D>;@{pop@,}

    [download]

    Update2: 88 characters. 

    perl -l

@_=sort@_;$"='?';push@{$,[length]},$_ for grep{(join'',sort/./sg)=~/$\
+@_?$/}<D>;@{pop@,}

    [download]

    ------
    We are the carpenters and bricklayers of the Information Age.

    Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

[reply]
[d/l]
[select]
      wow, that junk after the push is hard on the eyes... ;-)

      I really like the /./sg trick, but why use the /s? Getting rid of that newline has been one of the big obstacles on the course. Stealing this trick (w/o the /s) lets me get rid of the $/ $\ nonsense, shortening my return-the-whole-list code to 52 chars! 

      #        1         2         3         4         5
#234567890123456789012345678901234567890123456789012
@_=sort@_;$"='?';grep{(join'',sort/./g)=~/^@_?$/}<D>

      [download]

      -Blake

[reply]
[d/l]
      dragonchild
      your solution has the same problems as gbarr It only prints out the first of the longest words.

      Stuffy
      That's my story, and I'm sticking to it, unless I'm wrong in which case I will probably change it ;~)
      may be reproduced under the SDL
[reply]
        I think you might want to recheck your tests... perhaps with your test there *is* only one longest word.

        For the list qw(a r t) both dragonchilds and gbarrs solutions produce 'art', 'tar', and 'rat' for me.

        -Blake

[reply]
[d/l]
Re: Re: "Countdown" (golf)
by stuffy (Monk) on Dec 01, 2001 at 08:07 UTC
    gbarr
    I thought you were the first one to answer the call on all aspects, however, you have a flaw. It only returns the first instance of the longest word. If I change the letters to "d u n s c a e y z" it will only print out "ascend" It will not print out all the longest words. 
    sub f {
#        1         2         3         4         5
#234567890123456789012345678901234567890123456789012345
my%h;$h{$_}++for@_;my@b;push @{$b[length]},$_ for grep{
#    6        7         8         9         0         1
#789012345678901234567890123456789012345678901234567890123
my%g=%h;$g{$_}--for/./gi;!grep{$_<0}values%g}<D>;@{$b[-1]}
}

    [download]
    I added on stroke to make it case insensitive, but I'm not sure how to make it print out all possible answers rather then just the first one.

    Stuffy
    That's my story, and I'm sticking to it, unless I'm wrong in which case I will probably change it ;~)
    may be reproduced under the SDL
[reply]
[d/l]

In Section Meditations