Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Twelve Days of Christmas

by ibanix (Hermit)
on Dec 13, 2002 at 16:03 UTC ( [id://219618]=poem: print w/replies, xml ) Need Help??

Happy Holidays, everyone!
This one runs! :-D

use strict; use warnings; my @prefix = ( 'first', 'second', 'third', 'fourth', 'fifth', 'sixth', 'seventh', 'eighth', 'ninth', 'tenth', 'eleventh', 'twelfth', ); my @gifts = ( 'a partridge in a pear tree', 'two turtle doves', 'three French hens', 'four calling birds', 'five golden rings', 'six geese a-laying', 'seven swans a-swimmings', 'eight maids a-milkings', 'nine ladies dancing', 'ten lords a-leaping', 'eleven pipers piping', 'twelve drummers drumming', ); my $once = 1; sub todays_gifts { my $day = shift(@_); print "On the $prefix[$day-1] of Christmas\,\n"; print "My true love gave to me\, \n"; do { if ($once && $day == 1) { print "$gifts[$day-1].\n\n"; $once-- +; return; } if ($day == 1) { print "and $gifts[$day-1].\n\n"; return; } print "$gifts[$day-1],\n"; $day--; } while ($day >= 1); print "\n"; } for (1..12) { todays_gifts $_; }

ibanix

$ echo '$0 & $0 &' > foo; chmod a+x foo; foo;

Replies are listed 'Best First'.
Re: Twelve Days of Christmas (with help from CPAN)
by grinder (Bishop) on Dec 13, 2002 at 17:02 UTC

    Heh, cute. Of course, I couldn't help but simplify this, with a little help from CPAN.

    #! /usr/bin/perl -w use strict; use Lingua::EN::Inflect qw/NUMWORDS ORD/; my @gift = ( 'this element purposely left blank', 'partridge in a pear tree', 'turtle doves', 'French hens', 'calling birds', 'golden rings', 'geese a-laying', 'swans a-swimmings', 'maids a-milkings', 'ladies dancing', 'lords a-leaping', 'pipers piping', 'drummers drumming', ); for my $day( 1..12 ) { print "On the ${\NUMWORDS(ORD($day))} day of Christmas,\nmy true l +ove gave to me,\n"; if( $day > 1 ) { print "${\NUMWORDS($_)} $gift[$_],\n" for reverse 2..$day; print 'and '; } print "a $gift[1].\n\n"; }

    Of course all those plurals are just begging for Lingua::EN::Inflect::PL but I leave that an exercise to the reader...

    Season's greetings to all the monks :o)


    print@_{sort keys %_},$/if%_=split//,'= & *a?b:e\f/h^h!j+n,o@o;r$s-t%t#u'
      Very nice. But still not Lazy enough. ;-)

      Try this:

      use Lingua::EN::Inflect qw/inflect NUM PART_PRES/; use Lingua::Conjunction qw/conjunction/; my @gift = ( '', 'partridge in a pear tree', 'turtle dove', 'French hen', 'calling bi +rd', 'gold ring', 'goose', 'swan', 'maid', 'lady', 'lord', 'piper', 'drummer', ); my @action = map {$_ && PART_PRES $_} ( '', '', '', '', '', '', ' a-lay', ' a-swim', ' a-milk', ' dance', ' a-leap', ' pipe', ' drum', ); for my $day( 1..12 ) { print inflect("On the NUMWORDS(ORD($day)) day of Christmas,\n"), "my true love gave to me:", conjunction( map { NUM($_); inflect "\n\tA(PL_N($gift[$_]))$action[$_]"} reverse 1..$day ), ".\n\n"; }

      Which then makes it easy to change it to:

      use Lingua::EN::Inflect qw/inflect NUM PART_PRES/; use Lingua::Conjunction qw/conjunction/; my @gift = ( '', 'Swiss Army switch statement', 'style of OO', 'loop type', 'sigil fix', 'catch block', 'junction', 'ref', 'sub', 'type', 'try', 'function', 'less-than', ); my @action = map {$_ && PART_PRES $_} ( '', '', '', '', '', '', ' OR', ' a-bind', ' overload', ' a-check', ' a-catch', ' curry', ' chain', ); for my $apo ( 1..12 ) { print inflect("In the NUMWORDS(ORD($apo)) Perl Apocalypse,\n"), "my Larry gave to me:", conjunction( map { NUM($_); inflect "\n\tA(PL_N($gift[$_]))$action[$_]"} reverse 1..$apo ), ".\n\n"; } ;-)
      Santa has to leave the Linuga::EN::Inflect module under the tree for your code to work... :-P
      I like it tho! ++!

      ibanix

      $ echo '$0 & $0 &' > foo; chmod a+x foo; foo;
Re: Twelve Days of Christmas
by Mr. Muskrat (Canon) on Dec 13, 2002 at 16:38 UTC

    ++ I knew you could do it!

    I had to remove your sig from the code before it would run... how'd that get in there?

    Small omission... it's the "Twelve Days of Christmas" so why aren't you printing "day"?
    print "On the $prefix[$day-1] day of Christmas\,\n";

      My .sig is embeded in code blocks, so it probally got in with the rest.

      As someone else already mentioned, it probally would have made more sense to replace all $day-1 with $day and change the body loop to  for (0..11) { todays_gift $_; }

      But oh well, it was fun to hack this together in ~ 20 minutes. :-D

      ibanix

      $ echo '$0 & $0 &' > foo; chmod a+x foo; foo;
Re: Twelve Days of Christmas
by cecil36 (Pilgrim) on Dec 16, 2002 at 15:02 UTC
    And for those who live in the South (or anywhere where cow tipping and bull**** bingo are pastimes), or who is a fan of Jeff Foxworthy...
    my @redneck_gifts = ( 'some parts to a Mustang GT', 'two huntin\' dogs', 'three shotgun shells', 'four big mud tires', 'five flannel shirts', 'six cans of Spam', 'seven packs of Red Man', 'eight table dancers', 'nine years probation', 'ten of Copenhagen', 'eleven rasslin\' tickets', 'twelve pack of Bud', );
Re: Twelve Days of Christmas
by jmcnamara (Monsignor) on Dec 19, 2002 at 12:17 UTC

    On a similar theme the following was a winning entry from the 1988 International Obfuscated C Code Contest (IOCCC). This is a compressed version of the original entry.
    #include <stdio.h> main(t,_,a) char *a; {return!0<t?t<3?main(-79,-13,a+main(-87,1-_, main(-86, 0, a+1 )+a)):1,t<_?main(t+1, _, a ):3,main ( -94, -27+t, a )&&t == 2 ?_<13 ?main ( 2, _+1, "%s %d %d\n" ):9:16:t<0?t<-72?main(_, t,"@n'+,#'/*{}w+/w#cdnr/+,{}r/*de}+,/*{*+,/w{%+,/w#q#n+,/#{l,+,/n{n+\ ,/+#n+,/#;#q#n+,/+k#;*+,/'r :'d*'3,}{w+K w'K:'+}e#';dq#'l q#'+d'K#!/\ +k#;q#'r}eKK#}w'r}eKK{nl]'/#;#q#n'){)#}w'){){nl]'/+#n';d}rw' i;# ){n\ l]!/n{n#'; r{#w'r nc{nl]'/#{l,+'K {rw' iK{;[{nl]'/w#q#\ n'wk nw' iwk{KK{nl]!/w{%'l##w#' i; :{nl]'/*{q#'ld;r'}{nlwb!/*de}'c \ ;;{nl'-{}rw]'/+,}##'*}#nc,',#nw]'/+kd'+e}+;\ #'rdq#w! nr'/ ') }+}{rl#'{n' ')# }'+}##(!!/") :t<-50?_==*a ?putchar(a[31]):main(-65,_,a+1):main((*a == '/')+t,_,a\ +1 ):0<t?main ( 2, 2 , "%s"):*a=='/'||main(0,main(-61,*a, "!ek;dc \ i@bK'(q)-[w]*%n+r3#l,{}:\nuwloca-O;m .vpbks,fxntdCeghiry"),a+1);}

    This is really worth running. You can compile as follows:     cc xmas.c -o xmas

    Reverse Engineering the Twelve Days of Christmas explains what is going on.

    Larry Wall was also a winner of the IOCCC in 1986 and 1987.

    --
    John.

Re: Twelve Days of Christmas
by frankus (Priest) on Dec 19, 2002 at 11:42 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: poem [id://219618]
Approved by ChemBoy
Front-paged by BrowserUk
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2024-03-28 14:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found