Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Perl Golf idea

by sweepy838 (Acolyte)
on Apr 27, 2012 at 20:51 UTC ( #967717=perlquestion: print w/ replies, xml ) Need Help??
sweepy838 has asked for the wisdom of the Perl Monks concerning the following question:

So here's the rules should you decide to play. Create a script as small as you can that will unscramble a list of given words using a dictionary, there is a challenge on a site called hackthissite with a very similar objective but i thought it would be a great idea to make this a perl golf competition? and it should not give possible matches, it should try to solve each word, if it cant then move on. enjoy :) and yes, i am also taking part :p ps: i've already written mine using C so this isn't a "do my homework" post, its just a bit of fun.

Comment on Perl Golf idea
Replies are listed 'Best First'.
Re: Perl Golf idea
by davido (Archbishop) on Apr 27, 2012 at 21:46 UTC

    Why don't you go ahead and post a Perl version of your own here, just for a bit of fun. The worst you could do is just transcribe the C version over to a Perl equivalent, and then you'd be showing us a target to try to best.


    Dave

      haha yes the WORST i could do is convert it to perl! im ashamed of posting it yet.. im trying to make it better. but here is the c version:
      string myword; string wlist = "dict.txt";string line; int strLen = myword.length( +);int c = 0; ifstream cfile(wlist); if (cfile.is_open()) { while (cfile.good()) { getline (cfile,line); if (strLen == line.length()) { bool match[strLen];string used[strLen];int matchcount = + 0; for (int i = 0; i < strLen; i++) { string ch = myword.substr(i, 1); for (int y = 0; y < strLen; ++y) { string kh = line.substr(y, 1); if (ch == kh) { if (used[y] == ch) match[matchcount] = 0; else { used[y] = ch; match[matchcount] = 1; matchcount++; break; } } } } c = 0; for (int t = 0; t < strLen; t++){if (match[t] == true) + ++c; } if (c == strLen) { return line; } delete [] match; } } cfile.close(); }
      I have a feeling that people think i'm getting them to do my "homework" ? seriously?

        Rewritten in Cerl (C++ transliterated into something that a Perl interpreter in a good mood may care to execute):

        my $myword; my $wlist = "dict.txt"; my $strLen = length $myword; open my $cfile, '<', $wlist or die "Can't open $wlist: $!\n"; while (defined (my $line = <$cfile>)) { next if $strLen != length $line; my @match; my @used; my $matchcount = 0; for (my $i = 0; $i < $strLen; $i++) { my $ch = substr $myword, $i, 1; for (my $y = 0; $y < $strLen; ++$y) { next if $ch ne substr $line, $y, 1; if ($used[$y] eq $ch) { $match[$matchcount] = 0; } else { $used[$y] = $ch; $match[$matchcount] = 1; $matchcount++; last; } } } my $c = 0; for (my $t = 0; $t < $strLen; $t++) { ++$c if ($match[$t]); } return $line if ($c == $strLen); } close $cfile;

        This is of course completely untested and not what I would consider to be Perlish, although it is strict compliant. Note that the minor structure changes I made could actually be pushed back to the original C++ code to clean up that code somewhat.

        True laziness is hard work
Re: Perl Golf idea
by thundergnat (Deacon) on Apr 30, 2012 at 20:01 UTC

    Here's a kind of half-assed one. Feed it the path to the dictionary file and a word and it will return all the matches.

    I.E.

    perl -e"sub w{join'',sort@_[0]=~/./g};$w=w pop;($w eq w$_)&&print for<>" ./dict.txt acert

    returns:

    caret
    cater
    crate
    react
    trace
    

    (with the dict.txt file I had. YMMV).

      Nice. I've managed to knock off twelve characters though...

      • @_[0] can be replaced with pop. This needs whitespace before it, but it's still shorter. Savings: 1 character.
      • eq can be replaced by the smart match operator, allowing the whitespace around it to be dropped. Savings: 2 characters.
      • Semicolon after sub definition not needed. Savings: 1 character.

      Now we've got:

      perl -E'sub w{join"",sort pop=~/./g}$w=w pop;($w~~w$_)&&print for<>' . +/dict.txt acert

      But, hell, we can go shorter. Let's switch from the join"",... construct with the babycart operator inside an interpolated string... "@{[...]}". Can't remember why I did this - doesn't actually reduce the size of the code, but I think it was necessary for some of the later stuff.

      perl -E'sub w{"@{[sort pop=~/./g]}"}$w=w pop;($w~~w$_)&&print for<>' . +/dict.txt acert

      Next, we stop passing a parameter to the w function, and use $_ instead. This means that we can take advantage of the fact that regular expressions get applied to $_ by default, giving us massive savings inside the function. Outside the function it's a mixed blessing. We need to assign that pop to $_ giving us a whole new statement. But we don't need to pass anything to w on either of its invocations, and we can drop the parentheses around the smart match comparison.

      perl -E'sub w{"@{[sort/./g]}"}$_=pop;$w=w;$w~~w&&print for<>' ./dict.t +xt acert

      Those two assignments in the middle started to grind my gears. I figured there must be a way to ditch the semicolon between them... and there is! The w function no longer cares about what parameters it's passed.

      perl -E'sub w{"@{[sort/./g]}"}$w=w$_=pop;$w~~w&&print for<>' ./dict.tx +t acert

      I could go two characters shorter, but only swapping from print to say which adds unsightly blank lines to the output.

      UPDATE: five characters more. Smart match can deal with arrayrefs!

      perl -E'sub w{[sort/./g]}$w=w$_=pop;$w~~w&&print for<>' ./dict.txt ace +rt
      perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
        One character less:
        perl -nlE'sub w{[sort/./g]}INIT{$w=w$_=pop}$w~~w&&say' ./dict.txt acer +t
        And if you don't mind the (second) argument getting printed, another 3 chars less:
        perl -nlE'sub w{[sort/./g]}$w||=w$_=pop;$w~~w&&say' ./dict.txt acert

        Umm. Wow. I knew there was room for improvement reduction but... tobyink++

Re: Perl Golf idea
by brx (Pilgrim) on May 02, 2012 at 13:41 UTC

    Here is a summary of replies to this little informal golf contest. I hope there will be more replies.

    • thundergnat

      perl -e'sub w{join"",sort@_[0]=~/./g};$w=w pop;($w eq w$_)&&print for<>' ./dict.txt acert
    • tobyink

      perl -E'sub w{[sort/./g]}$w=w$_=pop;$w~~w&&print for<>' ./dict.txt acert
    • JavaFan

      perl -nlE'sub w{[sort/./g]}INIT{$w=w$_=pop}$w~~w&&say' ./dict.txt acert
    • brx

      perl -E'@a=sort pop=~/./g;print grep@a~~[sort//g],<>' ./dict.txt acert
    • JavaFan, with the second argument getting printed (a dummy line must be added at the begining of dict.txt)

      perl -nlE'sub w{[sort/./g]}$w||=w$_=pop;$w~~w&&say' ./dict.txt acert
    • brx, with an extra newline after last line printed

      perl -E'@a=sort pop=~/./g;say grep@a~~[sort//g],<>' ./dict.txt acert
    • Update: thundergnat

      perl -nlE'($w//=[sort pop=~/./g])~~[sort//g]&&say' ./dict.txt acert

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://967717]
Approved by davido
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (7)
As of 2015-08-01 07:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found
    past polls