(Golf) Decorating the Christmas Tree

[Masem]

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 - [e-mail] || "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

[japhy]

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:??;

[Masem]

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 - [e-mail] || "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

[japhy]

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:??;

[belg4mit]

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"

[grinder]

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

[osfameron]

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

[japhy]

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:??;

[dragonchild]

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.

[Rhose]

*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)

[danboo]

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

[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

[japhy]

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:??;

[runrig]

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

[japhy]

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:??;

[japhy]

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:??;

[dragonchild]

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.

[jynx]

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
}

[lestrrat]

$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 :-)

[jmcnamara]

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.

[premchai21]

#!/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.

[blakem]

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

[George_Sherston]

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

[blakem]

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

-Blake

[Sidhekin]

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)},"