Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

(Golf) Decorating the Christmas Tree

by Masem (Monsignor)
on Dec 03, 2001 at 20:53 UTC ( #129108=perlmeditation: print w/replies, xml ) Need Help??

Everyone and their dog can probably write golf code that will print to STDOUT a 'tree' given a height $h:
For $h = 5: = === ===== ======= =========
However, tis the season, and it's time to decorate the tree! The decorations we have available are '0', '@', '*', and '+', and of course, we have a '*' for the top of the tree. Thus, given a tree of $h = 5 and a 'decoration fraction' of $f=0.3, the decorated tree might look something like:
* ==@ 0=*== ==+==*= @===0+==*

Thus, given a tree height $h, and a decoration fraction $f (which is the chance that any particular part of the tree will be decorated, save for the top of the tree), golf a solution that will print the decorated tree to STDOUT.

-----------------------------------------------------
Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
"I can see my house from here!"
It's not what you know, but knowing how to find it if you don't know that's important

Replies are listed 'Best First'.
Re: (Golf) Decorating the Christmas Tree
by japhy (Canon) on Dec 03, 2001 at 22:08 UTC
    Here's mine. Are we counting newlines in the character count? If not, I can format my function like so:
    sub tree { # 1 2 3 #2345678901234567890123456789012 ($h,$f)=@_;@_=map$"x--$h.($_-1?0 x(2*$_-1):'*').$/,1..$h;s/0/rand >$f?'=':qw(0 @ * +)[rand 4]/eg for@_;print@_
    That weighs in at 103.

    _____________________________________________________
    Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
    s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

      Newlines should count if they're being used as whitespace separators like you've got in the last few lines (eg the qw list, or separating '/eg' and the following 'for'). But that would seem to only push your code up to 107 characters (3 spaces for the qw, another trailing '/eg'.

      I think in the general rules of golf, the character count should be as if the entire function was in one line of text. You can add CRs later, but the golf should still work if I did s/\n//g on it.

      -----------------------------------------------------
      Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
      "I can see my house from here!"
      It's not what you know, but knowing how to find it if you don't know that's important

        The count would be 109. You did not include the space needed between "0" and "x", nor the space needed between "rand" and "4".

        _____________________________________________________
        Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
        s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

Re: (Golf) Decorating the Christmas Tree
by belg4mit (Prior) on Dec 03, 2001 at 21:31 UTC
    Okay well here's a (weak?) attempt to use as a benchmark (214 chars):
    ($h,$f)=(23,.9); @F=qw(o @ + %);$\="\n"; sub Z{my $s;$s.=rand()<$f?$F[rand $#F+1]:'='for(1..$_[0]);$s;} print ' 'x&z(0,2),'*';sub z {(($h*2)+1-$_[0])/$_[1];} for$i(1..$h-1){$i*=2;$i++;print ' 'x&z($i,2),Z($i);} print ' 'x&z(2,2),'| |';
    I replaced '*' with '%' as an ornament since IMHO it ought only be on top. And you can add new ornaments to @F at Will. Oh, and I added a trunk. Without embellishments it is 186 chars.

    UPDATE: Changed char counts to reflect runrig's assumption

    --
    perl -p -e "s/(?:\w);([st])/'\$1/mg"

Re: (Golf) Decorating the Christmas Tree
by grinder (Bishop) on Dec 03, 2001 at 21:56 UTC

    This is my first attempt at a golf (AFAICR) so don't laugh too hard...

    # assuming my $h = 5; # or whatever my $f = 0.3; # ditto tree($h,$f); sub tree { # counting from here print$"x--$_[0],"*\n";$.=3;for(reverse 0..$_[0]-1){print$"x$_,map({ran +d()<$f?substr'0@*+',rand(4),1:$_}split//,'='x$.),"\n";$.+=2} # to here give 129 chars }
    --
    g r i n d e r
    just another bofh
Re: (Golf) Decorating the Christmas Tree
by osfameron (Hermit) on Dec 03, 2001 at 22:11 UTC
    My first golf also, and not warnings safe. Followed some of belg4mit's conventions. 174 chars.
    ($h,$f,@F)=(5,.3,qw'@ + O %');sub x{printf"%+${h}s\n",$_[0]};x('*'); sub f{my$x;for(1..$_[0]){$x.=(rand()<$f)?$F[rand$#F+1]:'='}$x} for(1..($h-1)){$h++;x(f(1+(($_)*2)));}
    Cheerio!
    Osfameron
README: The Sand Wedge (Re: (Golf) Decorating the Christmas Tree)
by japhy (Canon) on Dec 03, 2001 at 23:41 UTC
    I've been trimming people's posts down by a couple bytes here and there, and I'd like to explain what I did. I'll use danboo's code:
    print' 'x(--$h).($_==1?'*':join'',map{rand>$f?'=' :qw(* 0 @ +)[rand 4]}1..$_*2-1)."\n"for 1..$h
    Ok. ' ' can be replaced by $" which defaults to a space (1 char). The parens around --$h are unnecessary (2 chars). $_==1?X:Y can be rewritten as $_-1?Y:X (1 char). "\n" can be replaced by $/ (2 chars). That results in a s(h)aving of 6 chars, bringing it from 94 to 88.

    _____________________________________________________
    Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
    s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

      You don't need the join. Just use the fact that print takes a list.
      print$"x$h--,"*\n",map{$"x$h--,(map{rand>$f?'=':qw(* 0 @ +)[rand 4]}0. +.2*$_),$/}1..$h
      85 chars (without assignment). :-)

      At some point, I'd like someone to explain to me how that nested map doesn't get confused. *laughs*

      ------
      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.

      *Smiles*

      You hit all the ones I would never find, but you have kept the only one I found obvious --

      Since the number are not being used in any calculations, 1..$_*2-1 can be rewritten as 2..$_*2 (2 chars)

Re: (Golf) Decorating the Christmas Tree
by danboo (Beadle) on Dec 03, 2001 at 23:05 UTC
    well my first attempt came in at the same length as japhy's (109 chars, 98 excluding the setting of $h and $f):
    ($h,$f)=@_;for(1..$h){print' 'x($h-$_).($_==1?'*':join'',map{rand>$f?' +=':qw(* 0 @ +)[rand 4]}1..$_*2-1)."\n"}
    ... so i had no choice but to cheat. =) the following satisfies the rules strictly speaking, but only uses '0' as a decoration. it's 91 chars (or 80 excluding the setting of $h and $f).
    ($h,$f)=@_;for(1..$h){print' 'x($h-$_).($_==1?'*':join'',map{rand>$f?' +=':0}1..$_*2-1)."\n"}
    of course japhy's entry could be modified similarly, thereby bringing us equal again.

    oh well, as they say, cheaters never win.

    - danboo

      of course i just realized i could legally cut my chars down to 105 (94 excluding the setting of $h and $f) with:
      ($h,$f)=@_;print' 'x(--$h).($_==1?'*':join'',map{rand>$f?'=':qw(* 0 @ ++)[rand 4]}1..$_*2-1)."\n"for 1..$h
      - danboo
        And I can trim it to 88 (if we leave out the assignment):
        print$"x--$h.($_-1?join'',map{rand>$f?'=':qw (* 0 @ +)[rand 4]}1..$_*2-1:'*').$/for 1..$h

        _____________________________________________________
        Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
        s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

Re: (Golf) Decorating the Christmas Tree
by runrig (Abbot) on Dec 03, 2001 at 22:58 UTC
    I don't think the rules are clearly defined, so here's my attempt to clarify them (though Masem is the final arbiter, of course :), it sounds like we assume that $h and $f are already set, and so don't count that assignment, though we do count the assignment of the 'decoration character class'. So following what I think are the rules (subject to clarification), here's my try weighing in at 96 characters:
    $j=-1;print" "x(--$h),map({$_==1?"*":rand()<$f?(qw(0 @ * +))[rand 4]:" +="}1..($j+=2)),$/for 1..$h
    Update: Curses! foiled again :-)

    Though japhy's reply does lead to this 87 character answer:

    $j=1;print$"x--$h,($_-1?map rand>$f?"=":qw(0 @ * +)[rand 4],1..($j+=2) +:"*"),$/for 1..$h
      Every line of your tree starts with a star! But I can knock the count down a bit:
      $j--;print$"x--$h,($j+=2and$_-1?map rand>$f?"=" :qw(0 @ * +)[rand 4],1..$j:"*"),$/for 1..$h
      That's an even 90. Oh, I'm using Perl 5.6, so I can write qw(...)[...] and get away with it.

      _____________________________________________________
      Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
      s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

      I can tie Rhose's 86 by a tiny adjustment to yours:
      $j=1;print$"x--$h,$_-1?map(rand>$f?"=":qw( 0 @ * +)[rand 4],1..($j+=2)):"*",$/for 1..$h
      I moved a set of parens. And I can trim it even more:
      print$"x--$h,$_-1?map(rand> $f?"=":qw(0 @ * +)[rand 4], 1..($j+=2)):"*",$/for++$j..$h
      I moved $j's assignment to the "fore" loop. 83 characters. And then another adjustment that gets rid of $j entirely, and puts me at (an updated) 77 -- the parens around map's arguments were unneeded.
      print$"x--$h,$_-1?map rand> $f?"=":qw(0 @ * +)[rand 4], 2..$_*2:"*",$/for 1..$h

      _____________________________________________________
      Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
      s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

        Independently arriving at this (after playing some more), I get:
        print$"x$h--,$_-1?map{rand>$f?'=':qw(* 0 @ +)[rand 4]}2..2*$_:'*',$/fo +r 1..$h
        For some reason, I count that at 77?? Why am I one shorter?

        ------
        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.

Re: (Golf) Decorating the Christmas Tree
by lestrrat (Deacon) on Dec 04, 2001 at 00:27 UTC
    $h = 5; $f = 0.3; # 1 2 3 4 5 6 #23456789_123456789_123456789_123456789_123456789_123456789_123456789 print map{' 'x($h-$_),$_?map{$f>rand()?'=':(qw/0 @ * +/)[rand 4]}#65 0..2*$_:'*',"\n"}0..$h;#23

    88, and perl 5.005_03 compliant :-)

Re: (Golf) Decorating the Christmas Tree
by jynx (Priest) on Dec 04, 2001 at 03:31 UTC

    How about something different...

    Rather than checking rand for different values, i construct a heuristic and run through it for each character. It's only vaguely correct since it's difficult to extract integer values appropriately in only a few keystrokes. The first entry weighs in at 120 characters and doesn't assume that $f and $h are set for me. The second weighs in at 103 characters and assumes that they are set (but doesn't run under warnings). Thanks for the interesting golf Masem :)

    #1 sub f{ ($a,$b,@_)=(@_,split//,'0@*+'.'='x(4/(pop)-4); $b=2*$_-1,print$"x((2*$a-1-$b)/2),$_>1?map$_[rand@_],1..$b:'*',$/for 1 +..$a } #2 sub g{ +split//,'0@*+'.'='x(4/$f-4); $b=2*$_-1,print$"x((2*$h-1-$b)/2),$_>1?map$_[rand@_],1..$b:'*',$/for 1 +..$h }
    jynx

    update: i didn't notice the --$h trick, so i've shortened those still further:
    update2:oops, my heuiristic was hard-coded for 0.3. i've corrected all versions.

    #1 (at 97 characters) sub f{ ($a)=@_;+split//,'0@*+'.'='x(4/(pop)-4); print$"x--$a,$_>1?map$_[rand@_],1..2*$_-1:'*',$/for 1..$a } #2 (at 86 characters) sub g{ +split//,'0@*+'.'='x(4/$f-4); print$"x--$h,$_>1?map$_[rand@_],1..2*$_-1:'*',$/for 1..$h }
Re: (Golf) Decorating the Christmas Tree
by jmcnamara (Monsignor) on Dec 04, 2001 at 13:37 UTC

    129 characters.
    sub tree { ($h,$f,$s)=@_; split//,'0@*+'x(10*$f).'='x(40*(1-$f)); for(0..$h-1){ $s.=$/.$"x($h-$_); $s.=$_[rand@_]for+0..2*$_ } $s=~s/\S/*/; print$s }

    --
    John.

Re: (Golf) Decorating the Christmas Tree
by blakem (Monsignor) on Dec 04, 2001 at 01:46 UTC
    Stealing the decorations part from japhy I come in at 93 chars
    sub tree { # 1 2 3 4 5 6 #23456789012345678901234567890123456789012345678901234567890 ($h,$f)=@_;for$i(0..$h-1){print map($_<$h-$i?$":rand>$f?'=': # 7 8 9 #23456789012345678901234567890123 qw(0 @ * +)[rand 4],1..$h+$i),$/} }

    -Blake

Re: (Golf) Decorating the Christmas Tree
by George_Sherston (Vicar) on Dec 04, 2001 at 03:14 UTC
    update: thanks to blakem for his hint below. And I hasten to add that if the vars are allowed to be pre-defined, then it's 135.
    Alas, the best I can do is 148 146:
    sub golf { # 1 2 3 4 5 #2345678901234567890123456789012345678901234567890 ($h,$f)=@_;$w=$"x($h-1);$_="$w=$w\n";@a=qw/0 @ + * /;push @a,'=' for(1..4/$f);$p.=$_ while s/ (=+) /= $1=/;$p=~s#=#$a[rand 4/$f]#eg;print"$w*$w\n$p" } $golf(10,0.3); * =@= =+==@ @=@=0=+ ==+===@=* ==========0 0===0*=@*=@+= =+======@@====+ =====+=@====0==== ===@======+*+*=+==*


    George Sherston
      Just a quick golf tip: $" is one char shorter than ' '

      -Blake

Re: (Golf) Decorating the Christmas Tree
by premchai21 (Curate) on Dec 04, 2001 at 03:29 UTC
    #!/usr/bin/perl -l ($h, $f) = @ARGV; #234567891234567892234567893234567894234567895 # 0 0 0 0 0 @a=qw<0 @ * +>; for(1..$h){print$"x($h-$_),($j++?map{rand()<$f?$a[ rand@a]:'='}1..($_*2-1):'*'),$"x($h-$_)}

    105 code characters, +3 for the option -l, for a total of 108 characters.

Re: (Golf) Decorating the Christmas Tree
by Sidhekin (Priest) on Dec 06, 2001 at 22:43 UTC

    Slicing two more characters off japhy and dragonchild's tie, I end up at 75:

    print$"x--$h,qw(* 0 @ + =)[map$_?rand>$f?4:rand 4:0,$_..$_*3],$/for 0. +.$h-1

    Gotta love those slices :-)

    I found that one while working on a non-destructive solution (not modifying $h and $f, that is).
    I might as well include that ... 86 chars:

    printf"%*s\n",$_+$h,join"",qw(* 0 @ + =)[map$_?rand>$f?4:rand 4:0,$_.. +$_*3]for 0..$h-1

    The Sidhekin
    print "Just another Perl ${\(trickster and hacker)},"

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (1)
As of 2021-10-20 23:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (82 votes). Check out past polls.

    Notices?