Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Homework Golf

by McD (Chaplain)
on Dec 04, 2013 at 01:56 UTC ( [id://1065519]=perlmeditation: print w/replies, xml ) Need Help??

My second grader came home today with a bizzare homework problem:

Using a simple substitution cipher, where A=1, B=2, etc., define the value of a word to be the sum of its letters.

So far, so good.

But the assignment was to come up with a word ... worth exactly 65 points.

Really? C'mon, that's work for a computer, not a human.

Specifically, work for Perl. More specifically, a one-liner.

Which means it's good for a little golf! Here's my offering, finding 65-point words in the unix dictionary, in 93 bytes:

#23456789_123456789_123456789_123456789_123456789_123456789_123456789_ +123456789_123456789_123 perl -nle '$t=0;for $n (0..(length()-1)){$t+=(ord(lc substr($_,$n,1))- +96)}print if $t == 65;' /usr/share/dict/words

Update: Huge thanks to everyone who participated! I learned something new from each and every entry, which was at once rewarding and humbling. May I never stumble across any of this in production code! :-)

Replies are listed 'Best First'.
Re: Homework Golf
by oiskuu (Hermit) on Dec 04, 2013 at 07:19 UTC
    Um, the perl -nle'' count as 11? If so:

    42
    (Lowercase dictionary.)

    perl -lnE'unpack("%a*")-65-96*length||say'
    45
    (Lowercase dictionary.)
    perl -lne'65+length()*96-unpack"%a*"or print'
    50
    perl -lne'65+length()*96-unpack"%a*",lc or print'

    Note: I added the say version following Athanasius's example.

    Dec 05: x-d the readmore tags. Once more as above, using Abigail's Horror:

    #23456789_123456789_123456789_123456789_ perl -lnE'65+96*y///c-unpack"%a*"or say'

        And now I have to live the rest of my life knowing what that is, so thanks for that.

      Which can be shortened to modern perl:

      36 perl -nE'65+length()*96-unpack"%a*",lc or say'

      Enjoy, Have FUN! H.Merijn
        Except... -l option is necessary for otherwise \n is a problem.

        Update: Tux(20+21+24) == 65 :-)

        I love this one. Took me ten minutes and a command line to take it apart and grok it. Awesome.
Re: Homework Golf
by BrowserUk (Patriarch) on Dec 04, 2013 at 02:39 UTC

    57

    perl -nle"$n=0;map$n+=$_-96,unpack'C*',$_;$n!=65or print" words.txt

    54

    perl -nle"$n=0;$n+=ord(chop)-96while$_;$n!=65or print" words.txt

    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

      The second solution has a problem: each chop reduces $_ by one character until $_ is the empty string — which is what gets printed when $n is 65. My fix has 59 characters:

      #23456789_123456789_123456789_123456789_123456789_123456789 perl -nlE"$w=$_;$n=0;$n+=ord(chop)-96while$_;$n==65&&say$w" words.txt

      But the first solution can be reduced a little to 54 characters:

      #23456789_123456789_123456789_123456789_123456789_1234 perl -nlE"$n=0;map$n+=$_-96,unpack'C*',$_;$n==65&&say" words.txt

      :-)

      Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

Re: Homework Golf
by ambrus (Abbot) on Dec 04, 2013 at 07:32 UTC

    That brings back memories.

    Back in 2008 we've had some annoying users here who spent time with this numerology thingy by adding up the letters of a line in the Bible. It was at that time when I wrote a script to add up all lines of the kitty pidgin translation of the Bible translated so far. The most frequent sum turned out to be 442.

Re: Homework Golf
by atcroft (Abbot) on Dec 04, 2013 at 06:06 UTC

    I'll admit up front-I'm no golfer, and the way some monks can golf code so seemingly effortlessly still amazes me. Having said that, I was still pleased that I managed to get down to 77 characters (all commands in the form of perl -lne '$code' /usr/share/dict/words, unless otherwise noted. Counts only the code in quotes, so if I mis-counted, please let me know.):

    An interesting puzzle, McD-thank you for sharing it.

Re: Homework Golf (35)
by BrowserUk (Patriarch) on Dec 04, 2013 at 23:55 UTC

    35 (OR 46 depending upon which of the scoring method used in this thread you favour):

    #23456789_123456789_123456789_123456789_123456 # 123456789_123456789_123456789_12345 perl -nlE"unpack('%c*',$_&chr(31)x30)-65||say" words.txt

    On *nix, it can be 1 shorter (correct nested 's; thanks choroba):

    #23456789_123456789_123456789_123456789_12345 # 123456789_123456789_123456789_1234 perl -nlE'unpack("%c*",$_&"\x1f"x30)-65||say' words.txt

    And one shorter still:

    #23456789_123456789_123456789_123456789_12345 # 123456789_123456789_123456789_1234 perl -nlE'unpack("%c*",$_&"\c_"x30)-65||say' words.txt

    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

      On *nix ... one shorter still:
      #23456789_123456789_123456789_123456789_1234 perl -nlE'unpack("%c*",$_&"\c_"x30)-65||say' words.txt
      Two more strokes can be shaved I believe (untested, no Unix box available right now):
      #23456789_123456789_123456789_123456789_12 perl -nlE'65^unpack"%c*",$_&~"`"x30or say' words.txt
      Update: an alternative using v31:
      #23456789_123456789_123456789_123456789_12 perl -nlE'65^unpack"%c*",$_&v31 x30or say' words.txt

        I (breifly) looked for a replacement for "\c_", but I was trying to xor two bareword chars together to produce chr(31). I found several pairs that worked, but then as ^ has lower precedence than x, I couldn't extend the string cos if you bracket the expression, x produces a list not a string :(. Didn't think of &~'`'. Or vstrings:( )

        Also couldn't see how to ditch the unpack parens.

        As neither of the strings needs escape processing (unlike "\c_"), you can switch the "s <-> 's and that works on windows also:

        C:\test>perl -nlE"65^unpack'%c*',$_&~'`'x30or say" words.txt | wc -l 1279

        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
        There’s a third alternative using uc :
        #23456789_123456789_123456789_123456789_12 perl -nlE'65^unpack"%c*","?"x30&uc or say'
        Those spaces around or are annoying... Let's use something else to express conditionnal printing. With -p, x= does the job:
        #23456789_123456789_123456789_123456789_1 perl -ple'$_ x=65==unpack"%c*","?"x30&uc'
        While we're looking at those switches... Why the -l? Removing it and adding ord("\n") (10) to the target (65) shaves another stroke:
        #23456789_123456789_123456789_123456789_ perl -pe'$_ x=75=~unpack"%c*","?"x30&uc'
        There's a much shorter solution using a 6-bit checksum. The problem is that it comes up with a few false positives (words whose value is 1, 129, 193...):
        #23456789_123456789_123456789_1234 perl -ple'$_ x=1==unpack"%6c*",uc' perl -pe'$_ x=11==unpack"%6c*",uc'
        Using a 5-bit checksum removes the need for uc, but brings even more false positives:
        #23456789_123456789_123456789_1 perl -ple'$_ x=1==unpack"%5c*"' perl -pe'$_ x=11==unpack"%5c*"' perl -nlE'1^unpack"%5c*"or say' perl -nE'11^unpack"%5c*"or say'

      Wow, I love this.

      $_&"\c_"x30

      ...is about as close to executable line noise as I've seen in a long, long time. Bravo!

      If I'm smart, I'll borrow all these tricks, next time I come up with a golf idea. :-)

Re: Homework Golf
by choroba (Cardinal) on Dec 04, 2013 at 11:24 UTC
    Reminds me of 100% Attitude :-)
    لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Re: Homework Golf
by Util (Priest) on Dec 05, 2013 at 02:56 UTC

    Perl 6 version:

    perl6 -n -e '.say if![+] -1,.uc.ords X-64'

    Tricks used: Changed `sum(...) == 65` to `!sum(-65,...)`. The `-65` became `-1` due to the `X- 64`.

    Note that Perl 6 requires whitespace in more places than Perl 5 does. Only two spaces were removed from my original version: `if !` and `X- 64`.

    Explanation:

    .meth
    Method call. Operates on $_ when no object precedes the dot.
    [+]
    [op] is "reduce" metaoperator. Here, it returns the sum.
    .uc
    Uppercase
    .ords
    List of ordinal values for every char in string.
    X-
    Xop is "cross" metaoperator. Here, it subtracts 64 from list on left.
    64
    Difference of ord('A') and cypher value `1`.
    ,
    Used here to avoid `== 65`; Instead, add -65 to the sum and test for zero.
    -1
    Difference of -65 and 64. The -1 gets changed to -65 by X- .
      Nicely played, bonus points for such a complete explanation, and top marks for showcasing Perl6 native goodies. Thank you!
      »»» This post is about the immature Perl 6, not the rock solid Perl 5 «««

      So (thus far) P6 "wins" (is shortest)?

      Even the obvious ungolfed P6 solution is nicely readable -- would be so even for a Perl 6 novice -- and is still just 32 chars inside the quotes:

      perl6 -n -e '.say if 65 == [+] .uc.ords X- 64'

        Technically, yes, the P6 is shortest and should win, but it seems a bit unsporting since the implicit contest was P5.

        Still, as an exhibition entry, I'd give it full marks for such an outstanding performance and such readable code. (Where "readable" is, um, relative. Kind of a tough call in this thread...)

        It's inspired me to go do this year's Perl6 Advent Calendar and spend another December trying to cozy up to the next generation of Perl!

Re: Homework Golf
by Jasper (Chaplain) on Dec 17, 2013 at 14:47 UTC
    I'm about a week late to this, but in case anyone hasn't posted something exactly like this:

    -p $_ x=65==map{97..ord lc}/./g

    thanks to user oiskuu for the correction on the 97

      $_ x=65==map{a..lc}/./g

      This 'problem' popped into my head again last week with the thought that, unusually, I'd been an idiot. :) This beats even Grimy's 5 bit match (with the false positives) into a cocked hat. I think I win :D

Re: Homework Golf
by sundialsvc4 (Abbot) on Dec 04, 2013 at 17:27 UTC
    So they teach programming in second grade now ... or, "is there an app for that?" (Finding words, I mean, not "second grade" ... or, do I?)
      No, the homework in question was actually simple math homework. Honestly, I don't think it was a great question for second graders, but maybe my irresistible bias towards a brute force answer clouds my judgement?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://1065519]
Approved by boftx
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (5)
As of 2024-03-29 10:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found