Code Golf: Spider webs - language-agnostic

Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
The challenge
The shortest code by character count to output a spider web with rings equal to user's input.
A spider web is started by reconstructing the center ring:
\_|_/
_/ \_
\___/
/ | \
Then adding rings equal to the amount entered by the user. A ring is another level of a "spider circles" made from \ / | and _, and wraps the center circle.
Input is always guaranteed to be a single positive integer.
Test cases
Input
1
Output
\__|__/
/\_|_/\
_/_/ \_\_
\ \___/ /
\/_|_\/
/ | \
Input
4
Output
\_____|_____/
/\____|____/\
/ /\___|___/\ \
/ / /\__|__/\ \ \
/ / / /\_|_/\ \ \ \
_/_/_/_/_/ \_\_\_\_\_
\ \ \ \ \___/ / / / /
\ \ \ \/_|_\/ / / /
\ \ \/__|__\/ / /
\ \/___|___\/ /
\/____|____\/
/ | \
Input:
7
Output:
\________|________/
/\_______|_______/\
/ /\______|______/\ \
/ / /\_____|_____/\ \ \
/ / / /\____|____/\ \ \ \
/ / / / /\___|___/\ \ \ \ \
/ / / / / /\__|__/\ \ \ \ \ \
/ / / / / / /\_|_/\ \ \ \ \ \ \
_/_/_/_/_/_/_/_/ \_\_\_\_\_\_\_\_
\ \ \ \ \ \ \ \___/ / / / / / / /
\ \ \ \ \ \ \/_|_\/ / / / / / /
\ \ \ \ \ \/__|__\/ / / / / /
\ \ \ \ \/___|___\/ / / / /
\ \ \ \/____|____\/ / / /
\ \ \/_____|_____\/ / /
\ \/______|______\/ /
\/_______|_______\/
/ | \
Code count includes input/output (i.e full program).

Perl, 164 chars
195 184 171 167 164
print#o=((map{$z=_ x($x=1+$N-$_);$"x$x." /"x$_."\\$z|$z/".'\ 'x$_.$/}0..($N=<>)),
"_/"x++$N." ".'\_'x$N.$/);
y'/\\'\/',#o||y#_# #,$t++||y#_ # _#,print while$_=pop#o
First statement prints out the top half of the spider web. Second statement uses transliteration operations to create a reflection of the top half.
This next one weighs in closer to 314 chars (of productive code), but is more in the spirit of the season.
; "
Tr Ic
K| |t
Re aT
", "H
av e
A: -
)H AL LO W
ee N" ," En
jo y_ Yo ur
_ C&& y"; ##
&I (); $N= 1+
<>; $,= $/;#O =(( map
$" x($ X=$N-$_). ${ f}x$_.$
B.${U}x$X.$P.${U}x$X.$
F.${b}x$_,0..$N-1),${g}x$N.(${S}
x3).${c}x$N);sub I{($F,$B,$U, $P)
=qw (/ \\ _ |);; ${
S}= " ";$f=$S.$F;$g=$ U.
$F ;$b=$B.$S;$c=$B.${U};}#{ P}=
#{ O}; while($_=pop#{P} ){ #{
P} || y:_: :;$spooky++ || 0|
0 || y#_ # _#;y:/:8:; ; ;
; ;; y:\\:/:;y:8:\\:; #O =
( #O ,$_);}print#O; q{
Do !Discuss:Rel ig
io n,Politi cs
,& &T
heG rea
tP ump
ki n}
Hat tip to http://www.ascii-art.de/ascii/s/spider.txt
I constructed the spider shaped code by hand, but see the Acme::AsciiArtinator module on CPAN for help with automating (or at least semi-automating) the task.

Golfscript - 124 chars
All whitespace is significant! If you accidently add a newline to the end there will be an extra _ at the end of the output
~):#,{#\:&-:0' ': *& '/':/+*'\\':~'_':
0*.'|':|\/~ +&*n}%
/+#* ~
+#*n ~+#*
#/ +*n#,{):& *#&-:( ~+*/[
](!=&*.|\~/ +(*n}%
Golfscript - 129 chars
~):#,{#\:&-:0' ': *&' /'*'\\':~'_':
0*.'|'\'/'~ +&*n}%'_/'#* '\_'#*n ~+#*
#'/ '*n#,{):& *#&-:( ~+*'/'[
](!=&*.'|'\~'/ '(*n}%
Golfscript - 133 chars
~):#,{#\:&-:0' ': *&' /'*'\\':~'_':
0*.'|'\'/'~ +&*n}%'_/'#*3 *'\_'#*n' \\'#*3
*#'/ '*n#,{):& *#&-:( ~+*'/''_ '1/(!=&*.'|'\~'/ '(*n}%

Python - 212 chars
n=input()+1;b,f,p,u,s='\/|_ '
a=[s*(n-i)+' /'*i+b+u*(n-i)+p+u*(n-i)+f+'\ '*i+s*(n-i)for
i in range(n)]
print"\n".join(a+['_/'*n+s*3+'\_'*n,' \\'*n+u*3+'/ '*n]+[x[::-1]for
x in a[:0:-1]]+[a[0][::-1].replace(u,s)])

Perl: 161 characters
Note that this code includes the starting web in the source. (The doubled backslash at the end is a shame. An earlier version didn't have that.)
$_='
\_|_/
_/ \_
\___/
/_|_\\';
for$x(1..<>){
s|(.\S).*([/\\].)|$1$&$2|g;
s|\\(.*)/| \\_$1_/$` /$&\\ |;
s|(\s+)\K/(.*).$| \\$&/$1 /_$2_\\|
}
s|_(?=.*$)| |g;
print
The whitespace within $_ is significant (of course), but none of the rest is. If you have a minor suggestion that improves this, please feel free to just edit my code. For example, Kinopiko has nicely shaved off 6 characters!
Depending on how you count command-line switches, this might be shorter (154 by usual Perl golf rules if I can count correctly):
#!perl -ap
$_='
\_|_/
_/ \_
\___/
/_|_\\';
s|(.\S).*([/\\].)|$1$&$2|g,
s|\S(.*).| \\_$1_/$` /$&\\ |,
s|(\s+)\K/(.*).$| \\$&/$1 /_$2_\\|while$F[0]--;
s|_(?=.*$)| |g

Vb.net, windows console, Infer, Strict, Explicit ON.
Microsoft word is saying 442 characters without space
It might be possible to reduce it more but this is my last update(try #2)
Module z
Sub Main()
Dim i = CInt(Console.ReadLine), j = i + 1, h = j * 2 + 1, w = h * 2, z = "_", b = " "
For y = 0 To h
For x = 0 To w
Dim l = (x + y Mod 2 + i Mod 2) Mod 2, u = j + y, e = j - y, k = h + e, o = x = h Or x = h - 1
Console.Write(If(x = h, If(y = j, b, If(y = j + 1, z, "|")), "") & If(x = w, vbLf, If(y = j, If(x Mod 2 = 0 = (x < h), If(o, b, z), If(x < h, "/", "\")), If(x < k And x > u Or (x < u And x > k Or o) And y < h, z, If(x = k Or (x < u And y < j And x > e Or x > u And y > j And x < w + e) And l = 0, "/", If(x = u Or (x > k And y < j And x < h + u Or x < k And y > j And x > y - j - 1) And l = 1, "\", b))))))
Next
Next
End Sub
End Module

Python: 240 Characters
Nothing too tricky here; just printing line by line - 298 280 271 266 265 261 260 254 240 characters (ignore the last 2 line breaks)
u,b,f,s,a='_\/ |'
m=input()+1
print'\n'.join([(m-x)*s+x*' /'+b+(m-x)*u+a+(m-x)*u+f+x*'\ 'for x in
range(0,m)]+['_/'*m+s*3+'\_'*m+'\n'+(s+b)*m+u*3+'/ '*m]+[x*s+(m-x)*
' \\'+f+x*u+a+x*u+b+(m-x)*'/ 'for x in range(1,m)] + [s*m+f+s*m+a+s*m+b])

Lua, 290
n=...s=string r=s.reverse g=s.gsub a="\\|/"j=(" /"):rep(n+1)..a..("\\ "):rep(n+1) k=j o=k
l=n*4+7 for i=1,n+1 do k=g(k,"^(.- )/(.-)|(.*)\\(.-)$","%1%2_|_%3%4")o=k..o end
o=o..r(o)print((g(g(g(g(r(g(o:sub(1,l),"_"," ")..o:sub(l+1)),j,g(j," ","_")),("."):rep(l),"%1\n"),a," "),r(a),"___")))

Ruby1.9 - 181 chars
n=gets.to_i+1;s=' '
a=0.upto(n-1).map{|i|s*(j=n-i)+' /'*i+?\\+?_*j+'|'+?_*j+?/+'\ '*i+s*j}
d=a.reverse.map{|x|x.reverse};d[-1].tr!?_,s
puts a,'_/'*n+s*3+'\_'*n,' \\'*n+?_*3+'/ '*n,d
Ruby1.8 - 185 chars
Some improvements from JRL
n=gets.to_i+1;s=' '
u='_';a=0.upto(n-1).map{|i|s*(j=n-i)+' /'*i+'\\'+u*j+'|'+u*j+'/'+'\ '*i+s*j}
d=a.reverse.map{|x|x.reverse}
d[-1].tr!u,s;puts a,'_/'*n+s*3+'\_'*n,' \\'*n+u*3+'/ '*n,d
Ruby - 207 chars
Ruby seems to have some peculiar rules about the "\"
n=eval(gets)+1
b,f,p,u,s='\/|_ '.split""
a=0.upto(n-1).map{|i|s*(j=n-i)+' /'*i+b+u*j+"|"+u*j+f+"\\ "*i+s*j}
puts a,'_/'*n+s*3+'\_'*n,' \\'*n+u*3+'/ '*n,a[1..-1].reverse.map{
|x|x.reverse},a[0].reverse.tr(u,s)

Ruby1.8, 179
Run with ruby -n
n=$_.to_i+1
u,s,c=%w{_ \ \ \\}
z=(1..n).map{|i|k=n-i
s*i+c*k+'/'+u*i+'|'+u*i+"\\"+'/ '*k+s*i}
y=z.reverse.map{|a|a.reverse}
z[-1].tr!u,s
puts y,'_/'*n+s*3+'\_'*n,c*n+u*3+'/ '*n,z
In the first attempt below it seemed like a good idea to just generate one quadrant (I chose lower left), and then mirror twice to get the whole web. But gnibbler got better results generating both quadrants (of the top half) and then generating rather than patching up the inner area. So I revised mine to initially generate the other lower quadrant also, mirror only once, and also to leave the innermost row out of the mirror, which kind of converges with the other entry.
Ruby, 241
n=$_.to_i+1
m=2*n+1
u,s,b,f=%w{_ \ \\ /}
z=(0..n).map{|i|s*i+(s+b)*(n-i)+(i==0?u:f)+u*i}
q=z.reverse.map{|a|a.tr f+b,b+b+f}
q[n].gsub!' ','_'
q[n][m-1]=s
z=(q+z).map{|a|a+'|'+a.reverse.tr(f+b,b+b+f)}
z[n][m]=z[n+1][m]=s
z[m].gsub!u,s
puts z

C, 573 chars
Obviously it isn't even in the running w/regard to the character count. The 573 number is just the file size on my windows machine, so that probably counts a few ctrl-M's. On the other hand, maybe 573 is under-counting it, since I incurred the wrath of the compiler by jettisoning all the #include's to save space, warnings be damned!
But hey, this is my first time attempting one of these, and it will undoubtedly be good practice to try to re-express it in something more compact.
#define B puts("");
#define K '\\'+'/'
#define F '_'+' '
#define P(s) putchar(s);
#define I int
c(I s,I f){if(s){P(f)c(s-1,f);P(f)}else P('|')}
w(I lw,I s,I k,I f){if(s){P(' ')P(k)w(lw,s-1,k,f);P(K-k)P(' ')}else{P(K-k)c(1+lw,f);P(k)}}
h(I g,I s,I k,I f){I i;for(i=-1;i<g;++i)P(' ')w(g,s,k,f);}
t(I g,I s){if(s)t(g+1,s-1);h(g,s,'/','_');B}
b(I g,I s){h(g,s,'\\',s?'_':' ');B;if(s)b(g+1,s-1);}
m(I s,I k,I f){if(s){P(f)P(k)m(s-1,k,f);P(K-k)P(f)}else{P(F-f)P(F-f)P(F-f)}}
main(I ac,char*av[]){I s;s=atoi(av[1]);t(0,s);m(1+s,'/','_');B;m(1+s,'\\',' ');B;b(0,s);}

Python, 340 - 309 - 269 - 250 characters
Still room for improvement I think.
s=input()+1
f,b="/ ","\\"
r=range(s)
for i in r:w="_"*(s-i);print" "*(s+(i>=1)-i)+(f*i)[:-1]+b+w+"|"+w+"/"+"\ "*i
print"_/"*s+" "*3+"\_"*s+"\n"+" \\"*s+"_"*3+f*s
for i in r[::-1]:u="_ "[i<1]*(s-i);print" "*(s-i+(i>=1))+("\ "*i)[:-1]+"/"+u+"|"+u+b+f*i
-
Python (alternative version), 250 - 246 characters
s=input()+1;r=range(s);c="/","\\";y="/ ","\\ "
def o(i,r):u="_ "[i<1 and r]*(s-i);print" "*(s+(i>=1)-i)+(y[r]*i)[:-1]+c[r<1]+u+"|"+u+c[r]+(y[r<1]*i)[:-1]
for i in r:o(i,0)
print"_/"*s+" "*3+"\_"*s+"\n"+" \\"*s+"_"*3+"/ "*s
for i in r[::-1]:o(i,1)

Python and Ruby just about even*
I would rather have continued the comment thread above that briefly mentioned Python vs Ruby, but I need formatting to do this. Smashery is certainly classy but doesn't need to worry: it turns out that Python and Ruby are in a pretty close race by one measure. I went back and compared Python to Ruby in the eight code-golf's that I have entered.
Challenge Best Python Best Ruby
The Wave 161 99
PEMDAS no python entry (default victory?)
Seven Segs 160 175
Banknotes 83 (beat Perl!) 87
Beehive 144 164
RPN (no eval) 111 (157) 80 (107)
Cubes 249 233
Webs 212 181
Victories 3 4 (5?)
So the issue definitely isn't settled and got more interesting recently when gnibbler started entering on both sides. :-)
*I only counted fully functional entries.

dc - 262
A "straightforward" solution in dc (OpenBSD). Not a contender, but it is always fun. Line breaks for "readability"
[lcP1-d0<A]sA?sN[lK32sclAxRlNlK-l1scd0!=ARl3PlKl0sclAxRl9PlKlAxRl4PlNlK-
l2scd0!=AAPR]sW95s0124s9[ /]s1[\\ ]s292s347s4lN[dsKlWx1-d0<L]dsLx
[\\_][ ][_/][lN[rdPr1-d0<L]dsLxRRPlNlLxRR]dsBxAP[/ ][_ _][ \\]lBxAP[ \\]s1
[/ ]s247s392s41[dsKlWx1+dlN>L]dsLx32s032s9lNsKlWx
sample output
$ dc web.dc
3
\___|___/
/\__|__/\
/ /\_|_/\ \
_/_/_/ \_\_\_
\ \ \_ _/ / /
\ \/_|_\/ /
\/__|__\/
/ \

Perl 264 chars
shortened by in-lining the subroutines.
perl -E'$"="";($i=<>)++;#r=map{$p=$i-$_;#d=(" "x$_,(" ","\\")x$p,"/","_"x$_);($d="#d")=~y:\\/:/\\:;#d=reverse#d;$d.="|#d"}1..$i;say for reverse#r;$_=$r[0];y: _|:_ :;s:.(.*)\\.*/(.*).:$1_/ \\_$2:;say;y: _\\/:_ /\\:;say;$r[-1]=~y:_: :;say for grep{y:\\/:/\\:}#r;'
Expanded to improve readability.
perl -E'
$"="";
($i=<>)++;
#r=map{
$p=$i-$_;
#d=(
" "x$_,
(" ","\\")x$p,
"/",
"_"x$_
);
($d="#d")=~y:\\/:/\\:;
#d=reverse#d;
$d.="|#d"
}1..$i;
say for reverse#r;
$_=$r[0];
y: _|:_ :;
s:.(.*)\\.*/(.*).:$1_/ \\_$2:;
say;
y: _\\/:_ /\\:;
say;
$r[-1]=~y:_: :;
say for grep{y:\\/:/\\:}#r;
'
This is the code before I minimized it:
#! /opt/perl/bin/perl
use 5.10.1;
($i=<>)++;
$"=""; #" # This is to remove the extra spaces for "#d"
sub d(){
$p=$i-$_;
" "x$_,(" ","\\")x$p,"/","_"x$_
}
sub D(){
#d=d;
($d="#d")=~y:\\/:/\\:; # swap '\' for '/'
#d=reverse#d;
$d.="|#d"
}
#r = map{D}1..$i;
say for reverse#r; # print preceding lines
# this section prints the middle two lines
$_=$r[0];
y: _|:_ :;
s:.(.*)\\.*/(.*).:$1_/ \\_$2:;
say;
y: _\\/:_ /\\:;
say;
$r[-1]=~y:_: :; # remove '_' from last line
say for grep{y:\\/:/\\:}#r; # print following lines

(&)=(++) --9
f 0=[" \\_|_/","_/ \\_"," \\___/"," / | \\"] --52
f(n+1)=[s&h&u&"|"&u&g]&w(f n)&[s&g&s&"|"&s&h]where[a,b,c,d,e]=" _/\\|";[g,h]=["/","\\"];y=n+2;[u,s]=[r y b,r y a];p f s n x=let(a,b)=span(/=s)x in a&f b;i=dropWhile(==a);w[]=[];w[x]=[s&h&i(p(map(\x->if x==a then b else x))c d x)&g];w(l:e)|n==y*2-1=x%h:z|n>y=x&" "%" \\":z|n==y="_/"%"\\_":z|n<y=r(y-n)a&"\\ "%" /":z where n=length e;z=w e;x=r(n+1-y)a&g;(%)=(&).(&i l) --367
r=replicate --12
main=interact$unlines.f.read --29
Haskell entry weighing in at 469 characters. I'm sure there is a lot of room for improvement.
good luck trying to read it :)
here is a more readable version. Although there have been some changes since this version
spider 0=[" \\_|_/","_/ \\_"," \\___/"," / | \\"]
spider n=(s++"\\"++u++"|"++u++"/"):w m(spider(n-1))++[s++"/"++s++"|"++s++"\\"]
where
[a,b,c,d,e]=" _/\\|"
[m,y]=[y*2,n+1]
x=r y
[u,s]=[x b,x a]
t a b=map(\x->if x==a then b else x)
p f s n x=let(a,b)=span(/=s)x;(c,d)=span(/=n)b in a++f c++d
i=dropWhile(==a)
w _[]=[]
w _[x]=[s++"\\"++i(p(t a b)c d x)++"/"]
w(a+1)(l:e) |a==m-1=wrapline x l"\\":z
|a>y=wrapline(x++" ")l" \\":z
|a==y=wrapline"_/"l"\\_":z
|a<y=wrapline(r(y-a)' '++"\\ ")l" /":z
where
z=w a e
x=r(a+1-y)' '++"/"
wrapline b l a=b++i l++a
r=replicate
main=interact$unlines.spider.read

Related

Code Golf: Diamond Pattern

Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
The challenge
The shortest code by character count to output a a pattern of diamonds according to the input.
The input is composed of 3 positive numbers representing the size of the diamond and the size of the grid.
A diamond is made from the ASCII characters / and \ with spaces. A diamond of size 1 is:
/\
\/
The size of the grid consists from width and height of number of diamonds.
Test cases
Input:
1 6 2
Output:
/\/\/\/\/\/\
\/\/\/\/\/\/
/\/\/\/\/\/\
\/\/\/\/\/\/
Input:
2 2 2
Output:
/\ /\
/ \/ \
\ /\ /
\/ \/
/\ /\
/ \/ \
\ /\ /
\/ \/
Input
4 3 1
Output:
/\ /\ /\
/ \ / \ / \
/ \ / \ / \
/ \/ \/ \
\ /\ /\ /
\ / \ / \ /
\ / \ / \ /
\/ \/ \/
Code count includes input/output (i.e full program).
Golfscript - 50 chars
~#:3,[{[.3-~' '*\' '*'/'\.'\\'4$]2$*}%n*.-1%]*n*\;
Golfscript - 57 chars 50 chars
~\:b;\:a,{[.a-~" "*'/'#' '*.'\\'4$]b*}%n*.-1%](*n*
57 chars:
~:c;:b;:a,{:§;b{" "a§)-*."/"" "§2**#'\\'\}*]}%n*.-1%]c*n*
Mathematica - Pure Functional
A pure functional approach
f[a_, b_, c_]:=Grid[Array[If[(s = FindInstance [Abs[p =(2((2k+1)a + #1)-1)]
== (2#2-1), k, Integers])!={},
{"\\", , "/"}[[Sign[p] /. s[[1]]]]] &, 2 a {c, b}]]
Note that Mathematica is solving an equation for finding the function of the straight lines in the diamonds. It's a Diophantine equation in k:
Abs[(2((2 * k + 1)a + x)-1)] == (2 * y -1) (only find solutions for Integer k)
For each element, and then, if a solution is found, deciding the "\" or "/" based on the sign of the lhs of the equation. (in the {"\", , "/"}[[Sign[p] /. s[[1]] part )
Usage
f[2, 2, 2]
Or
Grid[f[2, 2, 2], f[1, 6, 2], f[4, 3, 3]]
for generating all test cases at once
Windows PowerShell, 124 123 121 119 116 112 chars
$s,$w,$h=-split$input
$(($a=1..$s|%{$x=' '*($s-$_--)
"$x/$(' '*$_)\$x"*$w})
$a|%{-join($_[-$s..($s-1)])*$w})*$h
If we allow the input to span three lines instead of being generally whitespace-separated we can get it down to 109:
$s,$w,$h=#($input)
$(($a=1..$s|%{$x=' '*($s-$_--)
"$x/$(' '*$_)\$x"*$w})
$a|%{-join($_[-$s..($s-1)])*$w})*$h
As arguments to the script (from within PowerShell) it'd be 105 bytes:
$s,$w,$h=$args
$(($a=1..$s|%{$x=' '*($s-$_--)
"$x/$(' '*$_)\$x"*$w})
$a|%{-join($_[-$s..($s-1)])*$w})*$h
This would then be called like this:
PS> .\diamond.ps1 2 2 2
Ruby - 115 bytes
a,b,c=gets.split.map &:to_i;puts (a...a+c*d=a*2).map{|y|(0...b*d).map{|x|x%d==y%d ?'\\':x%d==d-y%d-1?'/':' '}.to_s}
F#, 233 chars
let[|a;b;c|],(+),z,(!)=stdin.ReadLine().Split[|' '|]|>Array.map int,String.replicate," ",printfn"%s"
for r in 1..c do
for n in 1..a do !(b+(a-n+z^"/"^2*n-2+z^"\\"^a-n+z))
for n in 1..a do !(b+(n-1+z^"\\"^2*a-2*n+z^"/"^n-1+z))
Fun! A couple new bits for my F# code-golf arsenal:
using stdin rather than the cumbersome System.Console stuff
abusing operator overloading/redefinition
Perl - 161 (working program)
($s,$n,$m)=#ARGV;$i=$s;#a=qw(/ \\);--$a;do{$r.=sprintf("%${i}s".' 'x(($s-$i)*2)."%-${i}s",#a)x$n."\n";$i=1,$a=-$a,#a=#a[-1,0]unless$i+=$a}while$i<=$s;print$r x$m
Perl - 119 (second variant)
It's more cool idea... I'm using ability of interpolation of arrays to strings.
($s,$n,$m)=#ARGV;map{#a=#b=('')x$s;$a[-$_]='/';$b[$_-1]='\\';$z.="#a#b"x$n."\n";$x.="#b#a"x$n."\n"}1..$s;print"$z$x"x$m
Full second variant:
my ($s,$n,$m) = #ARGV; # take command line parameters
my ($z,$x); # variables for upper and lower parts of diamond
for (1..$s) { # lines of half diamond
my (#a,#b); # temporary arrays
#a=#b=('')x$s; # fill arrays with empty strings
$a[-$_]='/'; # left part of diamond
$b[$_-1]='\\'; # rigth part of diamond
$z .= "#a#b" x $n . "\n"; # adding n upper parts of diamonds
$x .= "#b#a" x $n . "\n"; # adding n lower parts of diamonds
}
print "$z$x" x $m; # "$z$x" - horizontal line of diamonds
JavaScript: 261 chars (Function)
function f(s,w,h){for(y=h,g=s*2;y--;){for(i=0,o=[];i<s;i++)for(x=0,o[i]=[],o[i+s]=[];x<w;x++){o[i][s-i-1+g*x]='/';o[i][s-i+i*2+g*x]='\\';o[i+s][g*x+i]='\\';o[i+s][g+g*x-i-1]='/'}for(a=0,z='';a<g;a++,console.log(z),z='')for(b=0;b<g*w;b++)z+=o[a][b]?o[a][b]:' '}}
JavaScript: 281 chars (Rhino Script with Standard Input/Output)
a=arguments;s=+a[0];w=+a[1];h=+a[2];for(y=h,g=s*2;y--;){for(i=0,o=[];i<s;i++)for(x=0,o[i]=[],o[i+s]=[];x<w;x++){o[i][s-i-1+g*x]='/';o[i][s-i+i*2+g*x]='\\';o[i+s][g*x+i]='\\';o[i+s][g+g*x-i-1]='/'}for(a=0,z='';a<g;a++,print(z),z='')for(b=0;b<g*w;b++)z+=o[a]?o[a][b]?o[a][b]:' ':' '}
Readable Rhino Version:
size = +arguments[0];
width = +arguments[1];
height = +arguments[2];
for (y = 0; y < height; y++) {
o = [];
for (i = 0; i < size; i++) {
// Will draw the top and bottom halves of each diamond row
// in a single pass. Using array o[] to store the data:
o[i] = [];
o[i + size] = [];
for (x = 0; x < width; x++) {
// Draw the top half of the diamond row:
o[i][(size - i - 1) + (size * 2 * x)] = '/';
o[i][(size - i) + (i * 2) + (size * 2 * x)] = '\\';
// Draw the bottom half of the diamond row:
o[i + size][(size * 2 * x) + i] = '\\';
o[i + size][(size * 2) + (size * x * 2) - i - 1] = '/';
}
}
// Output the full diamond row to console from array o[]:
for (a = 0; a < size * 2; a++) {
z = "";
for (b = 0; b < size * 2 * width; b++) {
z += o[a] ? o[a][b] ? o[a][b] : ' ' : ' ';
}
print(z);
}
}
Test Cases:
java org.mozilla.javascript.tools.shell.Main diamonds.js 4, 3, 2
/\ /\ /\
/ \ / \ / \
/ \ / \ / \
/ \/ \/ \
\ /\ /\ /
\ / \ / \ /
\ / \ / \ /
\/ \/ \/
/\ /\ /\
/ \ / \ / \
/ \ / \ / \
/ \/ \/ \
\ /\ /\ /
\ / \ / \ /
\ / \ / \ /
\/ \/ \/
java org.mozilla.javascript.tools.shell.Main diamonds.js 2, 6, 1
/\ /\ /\ /\ /\ /\
/ \/ \/ \/ \/ \/ \
\ /\ /\ /\ /\ /\ /
\/ \/ \/ \/ \/ \/
java org.mozilla.javascript.tools.shell.Main diamonds.js 1, 1, 1
/\
\/
Python, 125 chars
s,c,r=input()
l=[c*('%*c%*c%*s'%(s-i,47,2*i+1,92,s-i-1,''))for i in range(s)]
print'\n'.join(r*(l+[i[::-1]for i in l[::-1]]))
Input should be provided in comma-separated form, e.g. 1,6,2:
D:\CodeGolf> DiamondPattern.py
1,6,2
/\/\/\/\/\/\
\/\/\/\/\/\/
/\/\/\/\/\/\
\/\/\/\/\/\/
PS. if you prefer input separated with spaces (1 6 1), for the price of 21c replace first line with:
s,c,r=map(int,raw_input().split())
If you prefer command line arguments, for 25c more you can have
import sys;s,c,r=map(int,sys.argv[1:])
Python - 138 chars
s,r,c=eval("input(),"*3)
x=range(s);o="";l="\/";i=0
for k in x+x[::-1]:y=" "*(s-1-k);o+=(y+l[i<s]+" "*k+l[i>=s]+y)*c+"\n";i+=1
print o*r,
as a bonus it's also incredibly vulnerable to attack!
Haskell, 136 chars
r=readLn
main=do
n<-r;w<-r;h<-r;let d=2*n;y?x|mod(x+y-1)d==n='/'|mod(x-y)d==n='\\'|True=' '
mapM putStrLn[map(y?)[1..d*w]|y<-[1..d*h]]
Usage:
$ ./a.out
1
6
2
/\/\/\/\/\/\
\/\/\/\/\/\/
/\/\/\/\/\/\
\/\/\/\/\/\/
Python - 126 chars
s,w,h=input();z=s*2;w*=z;h*=z;
print("%s"*w+"\n")*h%tuple(
" \/"[(i/w%z==i%z)+((i/w+1)%z==-i%z)*2] for i in range(s*w,w*(h+s))
),
Line breaks and indentation added for clarity.
Clojure
(def ^:dynamic fc \/)
(def ^:dynamic sc \\)
(defn spaces [size]
(apply str (repeat size " ")))
(defn linestr[size line-no]
(let [sp (spaces size )
fh (doto (StringBuilder. sp)
(.setCharAt (- size line-no) fc)
(.toString))
sh (.replace (apply str (reverse fh)) fc sc) ]
(str fh sh)))
(defn linestr-x[number size line-no]
(apply str (repeat number (linestr size line-no))))
(defn print-all[number size]
(loop [line-no 1 lines []]
(if (> (inc size) line-no)
(recur (inc line-no) (conj lines (linestr-x number size line-no)))
lines)))
(defn diamond[number size]
(let [fh (print-all number size) ]
(binding [fc \\ sc \/]
(flatten [fh (reverse (print-all number size)) ]))))
(defn print-diamond[size cols rows]
(doseq [x (flatten (repeat rows (diamond cols size))) ]
(println x)))
(print-diamond 4 3 1)
user=> (print-diamond 1 10 3 )
/\/\/\/\/\/\/\/\/\/\
\/\/\/\/\/\/\/\/\/\/
/\/\/\/\/\/\/\/\/\/\
\/\/\/\/\/\/\/\/\/\/
/\/\/\/\/\/\/\/\/\/\
\/\/\/\/\/\/\/\/\/\/

Code Golf - π day

Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
The Challenge
Guidelines for code-golf on SO
The shortest code by character count to display a representation of a circle of radius R using the *character, followed by an approximation of π.
Input is a single number, R.
Since most computers seem to have almost 2:1 ratio you should only output lines where y is odd. This means that when R is odd you should print R-1 lines. There is a new testcase for R=13 to clarify.
eg.
Input
5
Output Correct Incorrect
3 ******* 4 *******
1 ********* 2 *********
-1 ********* 0 ***********
-3 ******* -2 *********
2.56 -4 *******
3.44
Edit: Due to widespread confusion caused by odd values of R, any solutions that pass the 4 test cases given below will be accepted
The approximation of π is given by dividing twice the number of * characters by R².
The approximation should be correct to at least 6 significant digits.
Leading or trailing zeros are permitted, so for example any of 3, 3.000000, 003 is accepted for the inputs of 2 and 4.
Code count includes input/output (i.e., full program).
Test Cases
Input
2
Output
***
***
3.0
Input
4
Output
*****
*******
*******
*****
3.0
Input
8
Output
*******
*************
***************
***************
***************
***************
*************
*******
3.125
Input
10
Output
*********
***************
*****************
*******************
*******************
*******************
*******************
*****************
***************
*********
3.16
Bonus Test Case
Input
13
Output
*************
*******************
*********************
***********************
*************************
*************************
*************************
*************************
***********************
*********************
*******************
*************
2.98224852071
C: 131 chars
(Based on the C++ solution by Joey)
main(i,j,c,n){for(scanf("%d",&n),c=0,i|=-n;i<n;puts(""),i+=2)for(j=-n;++j<n;putchar(i*i+j*j<n*n?c++,42:32));printf("%g",2.*c/n/n);}
(Change the i|=-n to i-=n to remove the support of odd number cases. This merely reduces char count to 130.)
As a circle:
main(i,j,
c,n){for(scanf(
"%d",&n),c=0,i=1|
-n;i<n;puts(""),i+=
0x2)for(j=-n;++j<n;
putchar(i*i+j*j<n*n
?c++,0x02a:0x020));
printf("%g",2.*c/
n/n);3.1415926;
5358979;}
XSLT 1.0
Just for fun, here's an XSLT version. Not really code-golf material, but it solves the problem in a weird-functional-XSLT-kind of way :)
<?xml version="1.0"?>
<xsl:stylesheet version="1.0"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
xmlns:msxsl="urn:schemas-microsoft-com:xslt" >
<xsl:output method="html"/>
<!-- Skip even lines -->
<xsl:template match="s[#y mod 2=0]">
<xsl:variable name="next">
<!-- Just go to next line.-->
<s R="{#R}" y="{#y+1}" x="{-#R}" area="{#area}"/>
</xsl:variable>
<xsl:apply-templates select="msxsl:node-set($next)"/>
</xsl:template>
<!-- End of the line?-->
<xsl:template match="s[#x > #R]">
<xsl:variable name="next">
<!-- Go to next line.-->
<s R="{#R}" y="{#y+1}" x="{-#R}" area="{#area}"/>
</xsl:variable><!-- Print LF-->
<xsl:apply-templates
select="msxsl:node-set($next)"/>
</xsl:template>
<!-- Are we done? -->
<xsl:template match="s[#y > #R]">
<!-- Print PI approximation -->
<xsl:value-of select="2*#area div #R div #R"/>
</xsl:template>
<!-- Everything not matched above -->
<xsl:template match="s">
<!-- Inside the circle?-->
<xsl:variable name="inside" select="#x*#x+#y*#y < #R*#R"/>
<!-- Print "*" or " "-->
<xsl:choose>
<xsl:when test="$inside">*</xsl:when>
<xsl:otherwise> </xsl:otherwise>
</xsl:choose>
<xsl:variable name="next">
<!-- Add 1 to area if we're inside the circle. Go to next column.-->
<s R="{#R}" y="{#y}" x="{#x+1}" area="{#area+number($inside)}"/>
</xsl:variable>
<xsl:apply-templates select="msxsl:node-set($next)"/>
</xsl:template>
<!-- Begin here -->
<xsl:template match="/R">
<xsl:variable name="initial">
<!-- Initial state-->
<s R="{number()}" y="{-number()}" x="{-number()}" area="0"/>
</xsl:variable>
<pre>
<xsl:apply-templates select="msxsl:node-set($initial)"/>
</pre>
</xsl:template>
</xsl:stylesheet>
If you want to test it, save it as pi.xslt and open the following XML file in IE:
<?xml version="1.0"?>
<?xml-stylesheet href="pi.xslt" type="text/xsl" ?>
<R>
10
</R>
Perl, 95 96 99 106 109 110 119 characters:
$t+=$;=1|2*sqrt($r**2-($u-2*$_)**2),say$"x($r-$;/2).'*'x$;for 0..
($u=($r=<>)-1|1);say$t*2/$r**2
(The newline can be removed and is only there to avoid a scrollbar)
Yay! Circle version!
$t+=$;=
1|2*sqrt($r**
2-($u-2*$_)**2)
,say$"x($r-$;/2
).'*'x$;for 0..
($u=($r=<>)-1|1
);$pi=~say$t*
2/$r**2
For the uninitiated, the long version:
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
# Read the radius from STDIN
my $radius = <>;
# Since we're only printing asterisks on lines where y is odd,
# the number of lines to be printed equals the size of the radius,
# or (radius + 1) if the radius is an odd number.
# Note: we're always printing an even number of lines.
my $maxline = ($radius - 1) | 1;
my $surface = 0;
# for ($_ = 0; $_ <= $maxline; $_++), if you wish
for (0 .. $maxline) {
# First turn 0 ... N-1 into -(N/2) ... N/2 (= Y-coordinates),
my $y = $maxline - 2*$_;
# then use Pythagoras to see how many stars we need to print for this line.
# Bitwise OR "casts" to int; and: 1 | int(2 * x) == 1 + 2 * int(x)
my $stars = 1 | 2 * sqrt($radius**2-$y**2);
$surface += $stars;
# $" = $LIST_SEPARATOR: default is a space,
# Print indentation + stars
# (newline is printed automatically by say)
say $" x ($radius - $stars/2) . '*' x $stars;
}
# Approximation of Pi based on surface area of circle:
say $surface*2/$radius**2;
FORTRAN - 101 Chars
$ f95 piday.f95 -o piday && echo 8 | ./piday
READ*,N
DO I=-N,N,2
M=(N*N-I*I)**.5
PRINT*,(' ',J=1,N-M),('*',J=0,M*2)
T=T+2*J
ENDDO
PRINT*,T/N/N
END
READ*,N
K=N/2*2;DO&
I=1-K,N,2;M=&
(N*N-I*I)**.5;;
PRINT*,(' ',J=&
1,N-M),('*',J=&
0,M*2);T=T+2*J;
ENDDO;PRINT*&
,T/N/N;END;
!PI-DAY
x86 Machine Code: 127 bytes
Intel Assembler: 490 chars
mov si,80h
mov cl,[si]
jcxz ret
mov bx,10
xor ax,ax
xor bp,bp
dec cx
a:mul bx
mov dl,[si+2]
sub dl,48
cmp dl,bl
jae ret
add ax,dx
inc si
loop a
mov dl,al
inc dl
mov dh,al
add dh,dh
mov ch,dh
mul al
mov di,ax
x:mov al,ch
sub al,dl
imul al
mov si,ax
mov cl,dh
c:mov al,cl
sub al,dl
imul al
add ax,si
cmp ax,di
mov al,32
ja y
or al,bl
add bp,2
y:int 29h
dec cl
jnz c
mov al,bl
int 29h
mov al,13
int 29h
sub ch,2
jnc x
mov ax,bp
cwd
mov cl,7
e:div di
cmp cl,6
jne z
pusha
mov al,46
int 29h
popa
z:add al,48
int 29h
mov ax,bx
mul dx
jz ret
dec cl
jnz e
ret
This version handles the bonus test case as well and is 133 bytes:
mov si,80h
mov cl,[si]
jcxz ret
mov bx,10
xor ax,ax
xor bp,bp
dec cx
a:mul bx
mov dl,[si+2]
sub dl,48
cmp dl,bl
jae ret
add ax,dx
inc si
loop a
mov dl,al
rcr dl,1
adc dl,dh
add dl,dl
mov dh,dl
add dh,dh
dec dh
mov ch,dh
mul al
mov di,ax
x:mov al,ch
sub al,dl
imul al
mov si,ax
mov cl,dh
c:mov al,cl
sub al,dl
imul al
add ax,si
cmp ax,di
mov al,32
jae y
or al,bl
add bp,2
y:int 29h
dec cl
jnz c
mov al,bl
int 29h
mov al,13
int 29h
sub ch,2
jnc x
mov ax,bp
cwd
mov cl,7
e:div di
cmp cl,6
jne z
pusha
mov al,46
int 29h
popa
z:add al,48
int 29h
mov ax,bx
mul dx
jz ret
dec cl
jnz e
ret
Python: 101 104 107 110 chars
Based on the other Python version by Nicholas Riley.
r=input()
t=0
i=1
exec"n=1+int((2*i*r-i*i)**.5)*2;t+=2.*n/r/r;print' '*(r-n/2)+'*'*n;i+=2;"*r
print t
Credits to AlcariTheMad for some of the math.
Ah, the odd-numbered ones are indexed with zero as the middle, explains everything.
Bonus Python: 115 chars (quickly hacked together)
r=input()
t=0
i=1
while i<r*2:n=1+int((2*i*r-i*i)**.5)*2;t+=2.*n/r/r;print' '*(r-n/2)+'*'*n;i+=2+(r-i==2)*2
print t
In dc: 88 and 93 93 94 96 102 105 129 138 141 chars
Just in case, I am using OpenBSD and some supposedly non-portable extensions at this point.
93 chars. This is based on same formula as FORTRAN solution (slightly different results than test cases). Calculates X^2=R^2-Y^2 for every Y
[rdPr1-d0<p]sp1?dsMdd*sRd2%--
[dd*lRr-vddlMr-32rlpxRR42r2*lpxRRAP4*2+lN+sN2+dlM>y]
dsyx5klNlR/p
88 chars. Iterative solution. Matches test cases. For every X and Y checks if X^2+Y^2<=R^2
1?dsMdd*sRd2%--sY[0lM-[dd*lYd*+lRr(2*d5*32+PlN+sN1+dlM!<x]dsxxAPlY2+dsYlM>y]
dsyx5klNlR/p
To run dc pi.dc.
Here is an older annotated version:
# Routines to print '*' or ' '. If '*', increase the counter by 2
[lN2+sN42P]s1
[32P]s2
# do 1 row
# keeping I in the stack
[
# X in the stack
# Calculate X^2+Y^2 (leave a copy of X)
dd*lYd*+
#Calculate X^2+Y^2-R^2...
lR-d
# .. if <0, execute routine 1 (print '*')
0>1
# .. else execute routine 2 (print ' ')
0!>2
# increment X..
1+
# and check if done with line (if not done, recurse)
d lM!<x
]sx
# Routine to cycle for the columns
# Y is on the stack
[
# push -X
0lM-
# Do row
lxx
# Print EOL
10P
# Increment Y and save it, leaving 2 copies
lY 2+ dsY
# Check for stop condition
lM >y
]sy
# main loop
# Push Input value
[Input:]n?
# Initialize registers
# M=rows
d sM
# Y=1-(M-(M%2))
dd2%-1r-sY
# R=M^2
d*sR
# N=0
0sN
[Output:]p
# Main routine
lyx
# Print value of PI, N/R
5klNlR/p
Powershell, 119 113 109 characters
($z=-($n=$args[($s=0)])..$n)|?{$_%2}|%{$l="";$i=$_
$z|%{$l+=" *"[$i*$i+$_*$_-lt$n*$n-and++$s]};$l};2*$s/$n/$n
and here's a prettier version:
( $range = -( $R = $args[ ( $area = 0 ) ] ) .. $R ) |
where { $_ % 2 } |
foreach {
$line = ""
$i = $_
$range | foreach {
$line += " *"[ $i*$i + $_*$_ -lt $R*$R -and ++$area ]
}
$line
}
2 * $area / $R / $R
HyperTalk: 237 characters
Indentation is not required nor counted. It is added for clarity. Also note that HyperCard 2.2 does accept those non-ASCII relational operators I used.
function P R
put""into t
put 0into c
repeat with i=-R to R
if i mod 2≠0then
repeat with j=-R to R
if i^2+j^2≤R^2then
put"*"after t
add 1to c
else
put" "after t
end if
end repeat
put return after t
end if
end repeat
return t&2*c/R/R
end P
Since HyperCard 2.2 doesn't support stdin/stdout, a function is provided instead.
C#: 209 202 201 characters:
using C=System.Console;class P{static void Main(string[]a){int r=int.Parse(a[0]),s=0,i,x,y;for(y=1-r;y<r;y+=2){for(x=1-r;x<r;s+=i)C.Write(" *"[i=x*x+++y*y<=r*r?1:0]);C.WriteLine();}C.Write(s*2d/r/r);}}
Unminified:
using C = System.Console;
class P {
static void Main(string[] arg) {
int r = int.Parse(arg[0]), sum = 0, inside, x, y;
for (y = 1 - r; y < r; y += 2) {
for (x = 1 - r; x < r; sum += inside)
C.Write(" *"[inside = x * x++ + y * y <= r * r ? 1 : 0]);
C.WriteLine();
}
C.Write(sum * 2d / r / r);
}
}
Haskell 139 145 147 150 230 chars:
x True=' ';x _='*'
a n=unlines[[x$i^2+j^2>n^2|j<-[-n..n]]|i<-[1-n,3-n..n]]
b n=a n++show(sum[2|i<-a n,i=='*']/n/n)
main=readLn>>=putStrLn.b
Handling the odd numbers: 148 chars:
main=do{n<-readLn;let{z k|k<n^2='*';z _=' ';c=[[z$i^2+j^2|j<-[-n..n]]|i<-[1,3..n]];d=unlines$reverse c++c};putStrLn$d++show(sum[2|i<-d,i=='*']/n/n)}
150 chars:
(Based on the C version.)
a n=unlines[concat[if i^2+j^2>n^2then" "else"*"|j<-[-n..n]]|i<-[1-n,3-n..n]]
main=do n<-read`fmap`getLine;putStr$a n;print$2*sum[1|i<-a n,i=='*']/n/n
230 chars:
main=do{r<-read`fmap`getLine;let{p=putStr;d=2/fromIntegral r^2;l y n=let c m x=if x>r then p"\n">>return m else if x*x+y*y<r*r then p"*">>c(m+d)(x+1)else p" ">>c m(x+1)in if y>r then print n else c n(-r)>>=l(y+2)};l(1-r`mod`2-r)0}
Unminified:
main = do r <- read `fmap` getLine
let p = putStr
d = 2/fromIntegral r^2
l y n = let c m x = if x > r
then p "\n" >> return m
else if x*x+y*y<r*r
then p "*" >> c (m+d) (x+1)
else p " " >> c m (x+1)
in if y > r
then print n
else c n (-r) >>= l (y+2)
l (1-r`mod`2-r) 0
I was kinda hoping it would beat some of the imperative versions, but I can't seem to compress it any further at this point.
Ruby, 96 chars
(based on Guffa's C# solution):
r=gets.to_f
s=2*t=r*r
g=1-r..r
g.step(2){|y|g.step{|x|putc' * '[i=t<=>x*x+y*y];s+=i}
puts}
p s/t
109 chars (bonus):
r=gets.to_i
g=-r..r
s=g.map{|i|(g.map{|j|i*i+j*j<r*r ?'*':' '}*''+"\n")*(i%2)}*''
puts s,2.0/r/r*s.count('*')
PHP: 117
Based on dev-null-dweller
for($y=1-$r=$argv[1];$y<$r;$y+=2,print"\n")for($x=1-$r;$x<$r;$x++)echo$r*$r>$x*$x+$y*$y&&$s++?'*':' ';echo$s*2/$r/$r;
You guys are thinking way too hard.
switch (r) {
case 1,2:
echo "*"; break;
case 3,4:
echo " ***\n*****\n ***"; break;
// etc.
}
J: 47, 46, 45
Same basic idea as other solutions, i.e. r^2 <= x^2 + y^2, but J's array-oriented notation simplifies the expression:
c=:({&' *',&":2*+/#,%#*#)#:>_2{.\|#j./~#i:#<:
You'd call it like c 2 or c 8 or c 10 etc.
Bonus: 49
To handle odd input, e.g. 13, we have to filter on odd-valued x coordinates, rather than simply taking every other row of output (because now the indices could start at either an even or odd number). This generalization costs us 4 characters:
c=:*:({&' *'#],&":2%(%+/#,))]>(|#j./~2&|#])#i:#<:
Deminimized version:
c =: verb define
pythag =. y > | j./~ i:y-1 NB. r^2 > x^2 + y^2
squished =. _2 {.\ pythag NB. Odd rows only
piApx =. (2 * +/ , squished) % y*y
(squished { ' *') , ": piApx
)
Improvements and generalizations due to Marshall Lochbam on the J Forums.
Python: 118 characters
Pretty much a straightforward port of the Perl version.
r=input()
u=r+r%2
t=0
for i in range(u):n=1+2*int((r*r-(u-1-2*i)**2)**.5);t+=n;print' '*(r-n/2-1),'*'*n
print 2.*t/r/r
C++: 169 characters
#include <iostream>
int main(){int i,j,c=0,n;std::cin>>n;for(i=-n;i<=n;i+=2,std::cout<<'\n')for(j=-n;j<=n;j++)std::cout<<(i*i+j*j<=n*n?c++,'*':' ');std::cout<<2.*c/n/n;}
Unminified:
#include <iostream>
int main()
{
int i,j,c=0,n;
std::cin>>n;
for(i=-n;i<=n;i+=2,std::cout<<'\n')
for(j=-n;j<=n;j++)
std::cout<<(i*i+j*j<=n*n?c++,'*':' ');
std::cout<<2.*c/n/n;
}
(Yes, using std:: instead of using namespace std uses less characters)
The output here doesn't match the test cases in the original post, so here's one that does (written for readability). Consider it a reference implementation (if Poita_ doesn't mind):
#include <iostream>
using namespace std;
int main()
{
int i, j, c=0, n;
cin >> n;
for(i=-n; i<=n; i++) {
if (i & 1) {
for(j=-n; j<=n; j++) {
if (i*i + j*j <= n*n) {
cout << '*';
c++;
} else {
cout << ' ';
}
}
cout << '\n';
}
}
cout << 2.0 * c / n / n << '\n';
}
C++: 168 characters (with output I believe is correct)
#include <iostream>
int main(){int i,j,c=0,n;std::cin>>n;for(i=-n|1;i<=n;i+=2,std::cout<<"\n")for(j=-n;j<=n;j++)std::cout<<" *"[i*i+j*j<=n*n&&++c];std::cout<<2.*c/n/n;}
PHP: 126 132 138
(based on Guffa C# solution)
126:
for($y=1-($r=$argv[1]);$y<$r;$y+=2,print"\n")for($x=1-$r;$x<$r;$s+=$i,++$x)echo($i=$x*$x+$y*$y<=$r*$r)?'*':' ';echo$s*2/$r/$r;
132:
for($y=1-($r=$argv[1]);$y<$r;$y+=2){for($x=1-$r;$x<$r;#$s+=$i,++$x)echo($i=$x*$x+$y*$y<=$r*$r?1:0)?'*':' ';echo"\n";}echo$s*2/$r/$r;
138:
for($y=1-($r=$argv[1]);$y<$r;$y+=2){for($x=1-$r;$x<$r;#$s+=$i){$t=$x;echo($i=$t*$x++ +$y*$y<=$r*$r?1:0)?'*':' ';}echo"\n";}echo$s*2/$r/$r;
Current full:
for( $y = 1 - ( $r = $argv[1]); $y < $r; $y += 2, print "\n")
for( $x = 1-$r; $x < $r; $s += $i, ++$x)
echo( $i = $x*$x + $y*$y <= $r*$r) ? '*' : ' ';
echo $s*2 /$r /$r;
Can be without # before first $s but only with error_reporting set to 0 (Notice outputs is messing the circle)
Ruby 1.8.x, 93
r=$_.to_f
q=0
e=r-1
(p(('*'*(n=1|2*(r*r-e*e)**0.5)).center r+r)
q+=n+n
e-=2)while-r<e
p q/r/r
Run with $ ruby -p piday
APL: 59
This function accepts a number and returns the two expected items. Works correctly in bonus cases.
{⍪(⊂' *'[1+m]),q÷⍨2×+/,m←(2|v)⌿(q←⍵*2)>v∘.+v←2*⍨⍵-⍳1+2×⍵-1}
Dialect is Dyalog APL, with default index origin. Skill level is clueless newbie, so if any APL guru wants to bring it down to 10 characters, be my guest!
You can try it online on Try APL, just paste it in and put a number after it:
{⍪(⊂' *'[1+m]),q÷⍨2×+/,m←(2|v)⌿(q←⍵*2)>v∘.+v←2*⍨⍵-⍳1+2×⍵-1} 13
*************
*******************
*********************
***********************
*************************
*************************
*************************
*************************
***********************
*********************
*******************
*************
2.98225
And a bash entry: 181 186 190 chars
for((y=-(r=$1,r/2*2);y<=r;y+=2));do for((x=-r;x<=r;++x));do((x*x+y*y<r*r))&&{((++n));echo -n '*';}||echo -n " ";((x<r))||echo;done;done;((s=1000,p=n*2*s/r/r,a=p/s,b=p%s));echo $a.$b
Run with e.g. bash py.sh 13
Python: 148 characters.
Failed (i.e. not short enough) attempt to abuse the rules and hardcode the test cases, as I mentioned in reply to the original post. Abusing it with a more verbose language may have been easier:
a=3.0,3.125,3.16
b="1","23","3677","47899"
r=input()
for i in b[r/3]+b[r/3][::-1]:q=1+2*int(i);print ' '*(int(b[r/3][-1])-int(i))+'*'*q
print a[r/5]
bc: 165, 127, 126 chars
Based on the Python version.
r=read()
for(i=-1;r*2>i+=2;scale=6){n=sqrt(2*i*r-i*i)
scale=0
n=1+n/1*2
j=r-n/2
t+=2*n
while(j--)" "
while(n--)"*"
"
"}
t/r/r
(New line after the last line cannot be omitted here.)
JavaScript (SpiderMonkey) - 118 chars
This version accepts input from stdin and passes the bonus test cases
r=readline()
for(t=0,i=-r;i<r;i++)if(i%2){for(s='',j=-r;j<r;j++){t+=q=i*i+j*j<r*r
s+=q?'*':' '}print(s)}print(t*2/r/r)
Usage: cat 10 | js thisfile.js -- jsbin preview adds an alias for print/readline so you can view in browser
Javascript: 213 163
Updated
r=10;m=Math;a=Array;t=0;l=document;for(i=-r;i<r;i+=2){w=m.floor(m.sqrt(r*r-i*i)*2);t+=w*2;l.writeln(a(m.round(r-w/2)).join(' ')+a(w).join('*'));}l.writeln(t/(r*r))
Nobody said it had to render correctly in the browser - just the output. As such I've removed the pre tags and optimised it further. To view the output you need to view generated source or set your stylesheet accordingly. Pi is less accurate this way, but it's now to spec.
r=10;m=Math;a=Array;t=0;s='';for(i=-r;i<r;i++){w=m.floor((m.sqrt(m.pow(r,2)-m.pow(i,2)))*2);t+=w;if(i%2){z=a(m.round(r-w/2)).join(' ')+a(w).join('*');s+=z+'\n';}}document.write('<pre>'+(s+(t/m.pow(r,2)))+'</pre>')
Unminified:
r=10;
m=Math;
a=Array;
t=0;
s='';
for(i=-r;i<r;i++){
w=m.floor((m.sqrt(m.pow(r,2)-m.pow(i,2)))*2);
t+=w;
if(i%2){
z=a(m.round(r-w/2)).join(' ')+a(w).join('*');
s+=z+'\n';
}
}
document.write('<pre>'+(s+(t/m.pow(r,2)))+'</pre>');
Java: 234
class C{public static void main(String[] a){int x,y,s=0,r=Integer.parseInt(a[0]);for(y=1-r;y<r;y+=2){for(x=1-r;x<r;++x){boolean b=x*x+y*y<=r*r;s+=b?1:0;System.out.print(b?'*':' ');}System.out.println();}System.out.println(s*2d/r/r);}}
Unminified:
class C{
public static void main(String[] a){
int x,y,s=0,r=Integer.parseInt(a[0]);
for(y=1-r;y<r;y+=2){
for(x=1-r;x<r;++x) {
boolean b=x*x+y*y<=r*r;
s+=b?1:0;
System.out.print(b?'*':' ');
}
System.out.println();
}
System.out.println(s*2d/r/r);
}
}
GAWK: 136, 132, 126, 125 chars
Based on the Python version.
{r=$1
for(i=-1;r*2>i+=2;print""){n=1+int((2*i*r-i*i)**.5)*2
t+=2*n/r/r
printf"%*s",r-n/2,""
while(n--)printf"%c","*"}print t}

Code Golf: Beehive

Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
The challenge
The shortest code by character count that will generate a beehive from user input.
A beehive is defined a a grid of hexagons in a size inputted by the user as two positive numbers greater than zero (no need to validate input). The first number (W) represents the width of the beehive - or - how many hexagons are on each row. The second number (H) represents the height of the beehive - or - how many hexagons are on each column.
A Single hexagon is made from three ASCII characters: _, / and \, and three lines:
__
/ \
\__/
Hexagons complete each other: the first column of the beehive will be 'low', and the second will be high - alternating and repeating in the same pattern forming W hexagons. This will be repeated H times to form a total of WxH hexagons.
Test cases:
Input:
1 1
Output:
__
/ \
\__/
Input:
4 2
Output:
__ __
__/ \__/ \
/ \__/ \__/
\__/ \__/ \
/ \__/ \__/
\__/ \__/
Input:
2 5
Output:
__
__/ \
/ \__/
\__/ \
/ \__/
\__/ \
/ \__/
\__/ \
/ \__/
\__/ \
/ \__/
\__/
Input:
11 3
Output:
__ __ __ __ __
__/ \__/ \__/ \__/ \__/ \__
/ \__/ \__/ \__/ \__/ \__/ \
\__/ \__/ \__/ \__/ \__/ \__/
/ \__/ \__/ \__/ \__/ \__/ \
\__/ \__/ \__/ \__/ \__/ \__/
/ \__/ \__/ \__/ \__/ \__/ \
\__/ \__/ \__/ \__/ \__/ \__/
Code count includes input/output (i.e full program).
Perl, 99 characters
#P=map{$/.substr$".'__/ \\'x99,$_,$W||=1+3*pop}0,(3,6)x pop;
chop$P[0-$W%2];print" __"x($W/6),#P
Last edit: Saved one character replacing -($W%2) with 0-$W%2 (thanks A. Rex)
Explanation:
For width W and height H, the output is 2+2 * H lines long and 3 * W+1 characters wide, with a lot of repetition in the middle of the output.
For convenience, we let $W be 3 * W + 1, the width of the output in characters.
The top line consists of the pattern " __", repeated W/2 == $W/6 times.
The even numbered lines consist of the repeating pattern "\__/ ", truncated to $W characters. The second line of output is a special case, where the first character of the second line should be a space instead of a \.
The odd numbered lines consist of the repeating pattern "/ \__", truncated to $W characters.
We construct a string: " " . "__/ \" x 99. Note that the beginning of this string is the desired output for the second line. This line starting at position 3 is the desired output for the odd lines, and starting at position 6 for the even numbered lines.
The LIST argument to the map call begins with 0 and is followed by H repetitions of (3,6). The map call creates a list of the substrings that begin at the appropriate positions and are $W = 3 * W + 1 characters long.
There is one more adjustment to make before printing the results. If W is odd, then there is an extra character on the second line ($P[0]) that needs to be chopped off. If W is even, then there is an extra character on the bottom line ($P[-1]) to chop.
Python 2.6 - 144 characters including newlines
I can save about 20 more characters if the inputs are allowed to be comma separated.
C,R=map(int,raw_input().split())
print C/2*" __"+"\n "+("__/ \\"*99)[:3*C-C%2]
r=0
exec'r+=3;print ("\__/ "*99)[r:r+3*C+1-r/6/R*~C%2];'*2*R
The version that takes input from the command line is 4 more bytes:
import sys
C,R=map(int,sys.argv[1:])
print C/2*" __"+"\n "+("__/ \\"*99)[:3*C-C%2]
r=0
exec'r+=3;print ("\__/ "*99)[r:r+3*C+1-r/6/R*~C%2];'*2*R
C89 (136 characters)
x;y;w;main(h){for(h=scanf("%d%d",&w,&h)*h+2;y++
<h;++x)putchar(x>w*3-(y==(w&1?2:h))?x=-1,10:
"/ \\__"[--y?y-1|x?(x+y*3)%6:1:x%6<4?1:5]);}
Perl, 160 characters
$w=shift;for$h(-1..2*shift){push#a,join'',(('\__','/ ')x($w+$h))[$h..$w+$h]}
$a[0]=~y#\\/# #;$a[1]=~s/./ /;s/_*$//for#a;$a[$w%2||$#a]=~s/. *$//;print$_,$/for#a
No cleverness involved at all: just fill the array with characters, then weed out the ones that look ugly.
strager's masterpiece is only 137 characters when ported to Perl, but all credit should go to him.
$w=shift;$\=$/;for$y(1..($h=2+2*shift)){print map+(split//,'_ \__/ ')
[$y-1?$y-2|$_?($_+$y%2*3)%6+2:1:$_%6<4],0..$w*3-!($w&1?$y-2:$y-$h)}
J, 143 characters
4(1!:2)~(10{a.)&,"1({.4 :0{:)".(1!:1)3
|:(18,(}:,32-+:#{:)3 3 8 1 1 10$~3*x){(,' '&(0})"1,' '&(0 1})"1)(,}."1)(}."1,}:"1)(3++:y)$"1'/\',:' _'
)
Using J feels very awkward when dealing with variable-length strings and the sort of console-oriented user interaction that is assumed in other languages. Still, I guess this is not too bad...
Stealing ideas once more (J is much easier to work with once you find a way of looking at the problem in an array-structured way), here's mobrule's masterpiece ported in 124 (ick, it's longer than the original):
4(1!:2)~({.4 :0{:)".(1!:1)3
(x}~' '_1}(x=.-1-+:2|x){])((10{a.),(' ',,99#'__/ \',:' __'){~(i.>:3*x)+])"0]595 0,3 6$~+:y
)
C#, 216 characters
class B{static void Main(string[]a){int b=0,i=0,w=int.Parse(a[0])+1,z=2*w*(int.Parse(a[1])+1);for(;i<z;b=(i%w+i/w)%2)System.Console.Write("\\/ "[i>w&(w%2>0?i<z-1:i!=2*w-1)?b>0?0:1:2]+(++i%w<1?"\n":b>0?"__":" "));}}
Less obfuscated:
class B{
static void Main(string[]a){
int b=0,
i=0,
w=int.Parse(a[0])+1,
z=2*w*(int.Parse(a[1])+1);
for(;i<z;b=(i%w+i/w)%2)
System.Console.Write(
"\\/ "[i>w&(w%2>0?i<z-1:i!=2*w-1)?b>0?0:1:2]
+
(++i%w<1?"\n":b>0?"__":" ")
);
}
}
I used the following method:
input: 4 2
cols: 0 00 1 11 2 22 3 33 4 44
row 0:" | | |__| | | |__| |"
1:" |__|/| |\|__|/| |\|"
2:"/| |\|__|/| |\|__|/|"
3:"\|__|/| |\|__|/| |\|"
4:"/| |\|__|/| |\|__|/|"
5:"\|__|/| |\|__|/| | |"
Iterate from zero to (W+1)*(H*2+1). The *2 is because each comb is 2 lines tall, and +1 to account for the first line and end of lines.
Render two "pieces" of a hexagon per iteration:
Decide between " ", "\", and "/" for the first part
Decide between "__", " ", and "\n" for the second part
The pattern is evident if you look at a large enough honeycomb. Half the logic is there only to address exceptions in the first row, the end of the second row, and the last cell.
Ruby, 164
$ ruby -a -p bh.rb
strager's masterpiece in Ruby...
w,h = $F; w=w.to_i
(1..(h = h.to_i * 2 + 2)).each { |y|
(0...(w * 3 + (y != ((w & 1) != 0 ? 2 : h) ? 1:0))).each { |x|
$> << ('_ \__/ ' [
y - 1 != 0 ?
(y - 2 | x) != 0 ?
(x + y % 2 * 3) % 6 + 2 : 1 : (x % 6 < 4) ? 1:0]).chr
}
$> << $/
}
aka
w,h=$F;w=w.to_i
(1..(h=h.to_i*2+2)).each{|y|(0...(w*3+(y!=((w&1)!=0?2:h)?1:0))).each{|x|$><<('_ \__/ '[y-1!=0?(y-2|x)!=0?(x+y%2*3)%6+2:1:(x%6<4)?1:0]).chr}
$><<$/}
NewLisp: 257 chars
I'm sure this is not an optimal solution:
(silent(define(i v)(println)(set v(int(read-line))))(i'w)(i'h)(set't(+(* 3 w)1))(set'l " __/ \\__/ ")(define(p s e(b 0))(println(slice(append(dup" "b)(dup(s 6 l)w))0 e)))(p 0 t)(p 4(- t(% w 2))1)(dotimes(n(- h 1))(p 6 t)(p 9 t))(p 6 t)(p 9(- t(%(+ w 1)2))))
Less obfuscated:
(silent
(define (i v)
(println)
(set v (int (read-line))))
(i 'w)
(i 'h)
(set 't (+ (* 3 w) 1))
(set 'l " __/ \\__/ ")
(define (p s e (b 0))
(println (slice (append (dup " " b) (dup (s 6 l) w)) 0 e)))
(p 0 t)
(p 4 (- t (% w 2)) 1)
(dotimes (n (- h 1))
(p 6 t)
(p 9 t))
(p 6 t)
(p 9 (- t(% (+ w 1)2))))
I'm sure I could write the loop differently and save two lines and a few characters, for instance, but it's late...
Golfscript, 88 characters
Based on the mobrule's solution. It was a lot of work to get it smaller than that one! Newlines are just for clarity.
~:r;:c 3*):W 6/" __"*n
[][0]r[3 6]*+{[" ""__/ \\"99*+>W<]+.},;
c 2%-1 1if:r%)[-1<]+r%
n*
Explanation:
~:r;,:c # read input into rows, columns
3 *):W # store c*3+1 into W
6 /" __"*n # write out " __" W/6 times, plus newline
[] # initialize output array
[0]r[3 6]*+ # create array [0] + [3,6] repeated r times
{ # for every entry in the input array...
[" ""__/ \\"99*+ # create the magic string
>W< # truncate it between [n:W], where n is the cur entry
]+ # store this line in the output array
.},; # repeat for every entry in array
# now to handle the extra cases:
c 2%-1 1if:r% # reverse the array if c is odd, do nothing if it's even
)[-1<] # take the last entry in the array, cut off the last char
+r% # put it back on the array, and un-reverse it
n* # now join the array with newlines
Here is my original entry at 118 characters:
Late entry, but it's 2nd smallest! (I'm just using these to learn Golfscript). Newlines are for clarity.
~:r;:c 2%:o;c 2/:b" __"*n:e
{e" ""\\"if"__/ \\"b*o{"__"e{"":e}"/"if}{"":e}if n
"/"" \\__/"b*o" \\"""if n}r*
"\\__/ "b o+*
C89 - 261 necessary chars
All white spaces can be removed. My solution uses rotation of the board...
x,y,W,h,B[999],*a,*b,*c,*d;
main(w){
for(scanf("%d%d",&h,&w);y<h;y++,*b++ = *c++ = 63)
for(x=0,
W=w*2+2-(h==1),
a=B+y*W*3+y%2,
b=a+W,
c=b+W,
d=c+W;x++<w;)
*a++ = 60,
*a++ = *d++ = 15,
*b++ = *c++ = 63,
*b++ = *c++ = 0,
*d++ = 60;
for(x=W;--x>=0;puts(""))
for(y=0;y<h*3+1;putchar(B[x+y++*W]+32));
}
F#, 303 chars
let[|x;y|]=System.Console.ReadLine().Split([|' '|])
let p=printf
let L s o e=p"%s"s;(for i in 1..int x do p"%s"(if i%2=1 then o else e));p"\n"
if int x>1 then L" "" "" __ ";L" ""__""/ \\"
else L" ""__"""
for i in 1..int y-1 do(L"/"" \\""__/";L"\\""__/"" \\")
L"/"" \\""__/"
L"""\\__/"" "
EDIT
Now that there are finally some other answers posted, I don't mind sharing a less-obfuscated version:
let [|sx;sy|] = System.Console.ReadLine().Split([|' '|])
let x,y = int sx, int sy
let Line n start odd even =
printf "%s" start
for i in 1..n do
printf "%s" (if i%2=1 then odd else even)
printfn ""
// header
if x > 1 then
Line x " " " " " __ "
Line x " " "__" "/ \\"
else
Line x " " "__" " "
// body
for i in 1..y-1 do
Line x "/" " \\" "__/"
Line x "\\" "__/" " \\"
// footer
Line x "/" " \\" "__/"
Line x "" "\\__/" " "
C# 377 chars
Didn't want to disappoint anyone waiting for the "funny" C# answer.
Unfortunately, it's not 250 lines though...;)
using System;
class P{
static void Main(string[] a){
int i,j,w=Int32.Parse(a[0]),h=Int32.Parse(a[1]);
string n="\n",e="",o=e,l="__",s=" ",r=s+s,b=#"\",f="/";
string[] t={r+r,l,b+l+f,r,l,f+r+b,e,f,b,s};
for(i=0;i<w;)o+=t[i++%2];
for(i=0;i<2*h;i++){
o+=n+(i%2==0?i!=0?b:s:e);
for(j=0;j<w;)
o+=t[((j+++i)%2)+4];
o+=i!=0?t[((w+i)%2)+6]:e;
}
o+=n;
for(i=0;i<w;)o+=t[i++%2+2];
Console.Write(o);
}
}
Groovy, #375 chars
Same logic & code that #markt implemented in c#, but have changed few places for Groovy :)
public class FunCode {
public static void main(a) {
int i,j,w=Integer.parseInt(a[0]),h=Integer.parseInt(a[1]);
String n="\n",e="",o=e,l="__",s=" ",r=s+s,b="\\",f="/";
def t=[r+r,l,b+l+f,r,l,f+r+b,e,f,b,s];
for(i=0;i<w;)o+=t[i++%2];
for(i=0;i<2*h;i++){
o+=n+(i%2==0?i!=0?b:s:e);
for(j=0;j<w;)
o+=t[((j+++i)%2)+4];
o+=i!=0?t[((w+i)%2)+6]:e;
}
o+=n;
for(i=0;i<w;)o+=t[i++%2+2]; println(o);
}
}
Lua, 227 characters
w,h,s=io.read("*n"),io.read("*n")*2+2," " for i=1,h do b=(i%2>0 and "/ \\__" or "\\__/ "):rep(w/2+1):sub(1,w*3+1) print(i==1 and b:gsub("[/\\]",s) or i==2 and b:gsub("^\\",s):gsub("/$",s) or i==h and b:gsub("\\$",s) or b) end
208 characters, when width and height are read from command line.
s,w,h=" ",... h=h*2+2 for i=1,h do b=(i%2>0 and "/ \\__" or "\\__/ "):rep(w/2+1):sub(1,w*3+1) print(i==1 and b:gsub("[/\\]",s) or i==2 and b:gsub("^\\",s):gsub("/$",s) or i==h and b:gsub("\\$",s) or b) end

Code Golf: Decision Tree

Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
In Google Code Jam 2009, Round 1B, there is a problem called Decision Tree that lent itself to rather creative solutions.
Post your shortest solution; I'll update the Accepted Answer to the current shortest entry on a semi-frequent basis, assuming you didn't just create a new language just to solve this problem. :-P
Current rankings:
107 Perl
121 PostScript (binary)
132 Ruby
154 Arc
160 PostScript (ASCII85)
170 PostScript
192 Python
196 JavaScript
199 Common Lisp
212 LilyPond
273 Scheme
280 R
281 sed w/ bc
312 Haskell
314 PHP
339 m4 w/ bc
346 C
381 Fortran
462 Java
718 OCaml
759 F#
1554 sed
C++ not qualified for now
sed in 1554 chars (pure) / 281 (with bc)
Yes, seriously.
Usage: sed -r -f thisfile.sed < input.in > output.out
(works on GNU sed)
1d
/ /!{x
s/^$/Case #Y:/
:i
s/9Y/Y0/
ti
s/#Y/#0Y/
s/:/:0123456789/
s/(.)Y(.*):[0-9]*\1(.).*/\3\2Y:/
x
G
s/.*\n|Y//gp
z
:p
N
/[()]/s/ |\n//g
y/()/JK/
tp
H
d}
G
s/\n[^J]*/ %/
s/[^JK]*$//
:c
s/J1?([.-9]+)(.*)K/\2#\1/
/%#/by
:b
/J/s/T//
s/J([^JK]*)K/TC\1B/
tb
/ (.+) .*%\1C/{s/%[^C]*/%/
s/T.*B//
by}
s/%.*T/%/
:y
y/CB/JK/
tc
s/.\.0*\b//g
:r
/#.*#/{s/\w*#\w*$/C&B/
s/C(\w)(.*B)/\1C\2~/
s/"[^"]*/&0/g
:t
s/(\w)(C.*)(\w)B(.*~)/\1\2B\3\4\1\3/
T
s/~(10|2[01]|3[0-2]|4[0-3]|5[0-4]|6[0-5]|7[0-6]|8[0-7]|9.)/&Q/
s/(.)(.)Q/\2\1/
s/~0\w/`00/
s/~1\B/`0/
s/~22/`04/
s/~23/`06/
s/~24/`08/
s/~33/`09/
s/~25/`10/
s/~26|~34/`12/
s/~27/`14/
s/~28|~44/`16/
s/~29|~36/`18/
s/~35/`15/
s/~45/`20/
s/~37/`21/
s/~38|~46/`24/
s/~55/`25/
s/~39/`27/
s/~47/`28/
s/~56/`30/
s/~48/`32/
s/~57/`35/
s/~49|~66/`36/
s/~58/`40/
s/~67/`42/
s/~59/`45/
s/~68/`48/
s/~77/`49/
s/~69/`54/
s/~78/`56/
s/~79/`63/
s/~88/`64/
s/~89/`72/
s/~99/`81/
s/`(.)(.)/~\1'\2/
bt
:
s/(~.)'/\1/
s/..'/K&/
/K/bk
:v
s/=(,?.)'/\1/
s/,/1'/
t
s/B(.*)~/\1B"/
tr
s/"(\w*)0/A\1/g
/A.*A/{s/A[^A]*$/J&K/
:k
s/([^A])(J.*)([^A])K/\2K\1\3/
s/K(10|2[01]|3[0-2]|4[0-3]|5[0-4]|6[0-5]|7[0-6]|8[^9]|9.)/&Q/
s/(.)(.)Q/\2\1/
s/K0/=/
s/K11/=2/
s/K12/=3/
s/K13|K22/=4/
s/K14|K23/=5/
s/K15|K24|K33/=6/
s/K16|K25|K34/=7/
s/K(17|26|35|44)/=8/
s/K(18|27|36|45)/=9/
s/K(19|28|37|46|55)/W0/
s/K(29|38|47|56)/W1/
s/K(39|48|57|66)/W2/
s/K49|K58|K67/W3/
s/K59|K68|K77/W4/
s/K69|K78/W5/
s/K79|K88/W6/
s/K89/W7/
s/K99/W8/
s/W/=,/
/'/bv
s/\b=/K:/
tk
s/[:JK]A?//g
s/,/,0123456789GF/
s/(.),.*\1(.).*F/\2/
s/G/,0/
tk}
/A.*A/bv}
s/\w*C.*A//
tr
s/.*#/./
This solution omits the leading zero in front of the decimal point, and does not handle cases where the answer is 1.00. Luckily, the GCJ judge accepts the lack of a zero, and does not have any cases where the answer is 1.00.
To include the leading zero, change the last line to s/.*#/0./; and to handle a 1.00 case, append the line s/^$/1/.
Here's a solution that outsources the multiplication to bc:
1d
/ /!{x
s/\n.*//
s/.*/echo 0&+1|bc/e
x
g
s/.*/Case #&:/p
:p
N
/[()]/s/ |\n//g
y/()/JK/
tp
H
d}
G
s/\n[^J]*/ %/
s/[^JK]*$//
:c
s/J([.-9]+)(.*)K/\2*\1/
/%\*/s/.*%.(.*)/echo \1|bc -l/e
:b
/J/s/T//
s/J([^JK]*)K/TC\1B/
tb
/ (.+) .*%\1C/{s/%[^C]*/%/
s/T.*B//
b}
s/%.*T/%/
:
y/CB/JK/
tc
Perl in 107 characters
say("Case #$_:"),
$_=eval"''".'.<>'x<>,
s:[a-z]+:*(/ $&\\s/?:g,s/\)\s*\(/):/g,
eval"\$_=<>;say$_;"x<>for 1..<>
Newlines for legibility; none of them is necessary or counted in.
It uses features found only in the latest versions of Perl, so run with perl -M5.010 or later.
I used to be a Perl noob too, so this works almost the same as the ruby one. Original version 126 chars, optimizations by peutri.
Backlinks:
Word Aligned - Power Programming
LilyPond: 212 characters
Craziness! Utter ridiculousness!! LilyPond, with its built-in Scheme interpreter, manages to outdo Scheme by more than FIFTY BYTES! Holy acrobatic flying mooses in tights!!
x=#lambda
w=#read
#(letrec((v(x(a)(map a(iota(w)1))))(c(x(f q)(*(car q)(if(any list? q)(c
f((if(memq(cadr q)f)caddr cadddr)q))1)))))(v(x(i)(w)(set! #(w))(format
#t"Case #~a:
~{~y~}"i(v(x i(w)(c(v(x i(w)))#)))))))
Usage: lilypond thisfile.ly <input.in >output.out 2>/dev/null
Credit goes to cky for writing the Scheme solution this was based on, though this version is now substantially different. Seriously, though, the Scheme could be golfed a bit further...
PostScript: 170 (regular) / 160 (ASCII85) / 121 (binary)
My shortest (regular) PostScript solution so far, provided that you rename the input file to "r" (170 characters, including newlines); uses a GhostScript-specific procedure (=only):
1[/:{repeat}/!{exch token{\ exch known{/<>}if]pop]]3 index mul
!}if}(]){token pop}/?(r)(r)file([){?]}>>begin
1[{(Case #)2{=only}:(:)=[/|[def[{[/\<<[{[/}:>>def |]! =}:}for
Usage: cp input.in r; gs -q -dNOPROMPT -dNODISPLAY -dBATCH thisfile.ps > output.out
Here's a binary version of this in 121 bytes (backslashes and unprintable characters escaped):
1[/!{\x92>\x92\xab{\\\x92>\x92`\x92p{]\x92u}if]]3\x92X\x92l!}if}(]){\x92\xab\x92u}/r(r)\x928\x92A([){r]}>>\x92\r1[{(Case #)\x92v=only[/:\x928[\x923=[{[/\\<<[{[/}\x92\x83>>\x923:]! =}\x92\x83}\x92H
If characters outside the ASCII printable range are disallowed, PS has built-in ASCII85 encoding of binary sources. We therefore have the following 160-byte solution in all ASCII printable characters:
1[([){r]}/r(r)<~OuSUj0-P\*5*Dsn>`q:6#$5JU?'9>YBkCXV1Qkk'Ca"4#Apl(5.=75YP')1:5*?#0>C.bc#<6!&,:Se!4`>4SH!;p_OuQ[/1Herh>;'5D4Bm/:07B"95!G,c3aEmO4aiKGI?I,~>cvx exec
Ruby in 132
Improved by leonid. Newlines are essential.
def j
'1
'..gets
end
j.map{|c|s=j.map{gets}*''
puts"Case #%d:"%c,j.map{gets;eval s.gsub(/[a-z]+/,'*(/ \&\b/?').gsub /\)\s*\(/,'):'}}
Ruby in 136
def j;1..gets.to_i;end;j.map{|c|m=j.map{gets}*"";puts"Case ##{c}:";j.map{gets;p eval m.gsub(/[a-z]+/,'*(/ \0\s/?').gsub /\)\s*\(/,'):'}}
I just learned about *"" being equivalent to .join"". Also realised that map could be used in a few places
Ruby in 150
1.upto(gets.to_i){|c|m=eval("gets+"*gets.to_i+"''");puts"Case ##{c}:";1.upto(gets.to_i){gets;p eval m.gsub(/[a-z]+/,'*(/ \0\s/?').gsub /\)\s*\(/,'):'}}
I am just a noob to ruby, so there is probably still a lot of room for improvement
Python in 192
import re;S=re.sub;R=raw_input;I=input;c=0;exec r"c+=1;L=S('\) *\(',')or ',S('([a-z]+)','*(\' \\1 \'in a and',eval(('+R()'*I('Case #%s:\n'%c))[1:])));exec'a=R()+\' \';print eval(L);'*I();"*I()
Common Lisp, 199 bytes
Wrapped every 80 characters:
(defun r()(read))(dotimes(i(r))(format t"~&Case #~D:"(1+ i))(r)(set'z(r))(dotime
s(a(r))(r)(print(do((g(mapcar'read(make-list(r))))(p 1(*(pop c)p))(c z(if(find(p
op c)g)(car c)(cadr c))))((not c)p)))))
Spaced and indented:
(defun r () (read))
(dotimes (i (r))
(format t "~&Case #~D:" (1+ i))
(r)
(set 'z (r))
(dotimes (a (r))
(r)
(print
(do ((g (mapcar 'read (make-list (r))))
(p 1 (* (pop c) p))
(c z (if (find (pop c) g)
(car c)
(cadr c))))
((not c) p)))))
C - 346 bytes
Compile with gcc -w
#define N{int n=atoi(gets(A));for(;n--;)
T[999];F[99];char*t,*f,*a,A[99];float p(){float
d,m=1;for(;*t++^40;);sscanf(t,"%f %[^ (]",&d,A);if(*A^41){for(f=F;m**f;){for(;*f&&*f++^32;);for(a=A;*a&&*f==*a;f++,a++);m=*a||*f&64;}d*=!m*p()+m*p();}return
d;}main(I)N{printf("Case #%d:\n",I++);t=T;N
for(gets(t);*++t;);}N gets(F),t=T,printf("%f\n",p());}}}
Arc, 143 154 characters
Very similar to the CL one, but Arc sure has terse identifiers. Wrapped every 40 chars:
(for i 1((= r read))(prn"Case #"i":")(r)
(= z(r))(repeat(r)(r)(loop(= g(n-of(r)(r
))c z p 1)c(= p(*(pop c)p)c(if(pos(pop c
)g)c.0 cadr.c)))prn.p))
Indented:
(for i 1 ((= r read))
(prn "Case #" i ":")
(r)
(= z (r))
(repeat (r)
(r)
(loop (= g (n-of (r) (r))
c z
p 1)
c
(= p (* (pop c) p)
c (if (pos (pop c) g)
(c 0)
(cadr c))))
(prn p)))
Backlink: Word Aligned - Power Programming
JavaScript in 196 bytes
r='replace'
q=readline
for(n=0,t=q();t-n++;){for(print('Case #'+n+':'),d='',x=q();x--;d+=q());for(x=q();x--;)print(eval(d[r](/([a-z]+)/g,'*({'+q()[r](/ /g,':1,z')+':1}.z$1?')[r](/\) *\(/g,'):')))}
Usage: $ smjs thisfile.js <input.in
With contributions by Hyperlisk.
PHP in 314
<?php function q(){return trim(fgets(STDIN));}for($n=q($x=0);$x++<$n;){for($s=q($t='');$s--;$t.=q());echo"Case #$x:\n";for($z=q();$z--;){$l=explode(' ',q());$l[0]=0;printf("%f\n",eval('return'.preg_replace(array('/\(/','/(\w+),/','/(\d\)*),\((\d)/','/^./'),array(',(','*(in_array("$1",$l,1)?','$1:$2'),$t).';'));}}
FORTRAN - 381
Save as a.F95
Compile with f95 a.F95
#define _ ENDDO
#define A READ(t(k:l-1),*),a
#define Q j=1,n;READ"(A)",s
#define R READ*,n;DO
#define S k+SCAN(t(k:),'()')
CHARACTER(999)s,t,u;R i=1,n;t="";PRINT"('Case #'i0':')",i
R Q;t=TRIM(t)//s;_;R Q;d=1;k=1;DO;k=S;l=S-1
IF(t(l:l)>"(")EXIT;A,u;d=d*a;k=l;m=0
IF(INDEX(s," "//TRIM(u)//" ")>0)CYCLE;DO;IF(')'>t(k:k))m=m+2;m=m-1;k=k+1
IF(1>m)EXIT;k=S-1;_;_;A;d=d*a;PRINT*,d;_;_;END
By using the default format, each of the results starts with 2 spaces, but the google judge permits it. Thanks google judge!
EXPANDED VERSION
CHARACTER(999)s,t,u
READ*,n
DO i=1,n
t=""
PRINT"('Case #'I0':')",i
READ*,n
DO j=1,n
READ"(A)",s
t=TRIM(t)//s
ENDDO
READ*,n
DO j=1,n
READ"(A)",s
d=1
k=1
DO
k=k+SCAN(t(k:),'()')
l=k+SCAN(t(k:),'()')-1
IF(t(l:l)>"(")THEN
READ(t(k:l-1),*),a
d=d*a
PRINT*,d
EXIT
ELSE
READ(t(k:l-1),*),a,u
d=d*a
k=l
m=0
IF(INDEX(s," "//TRIM(u)//" ")>0)CYCLE
DO
IF(')'>t(k:k))m=m+2
m=m-1
k=k+1
IF(1>m)EXIT
k=k+SCAN(t(k:),'()')-1
ENDDO
ENDIF
ENDDO
ENDDO
ENDDO
END
Haskell, 312 characters
Here's another aproach to Haskell. I left the dirty work to the Prelude's lex. The wrapping around it is Text.ParserCombinators.ReadP. Importing it cost 36 characters on its own—ugh!
The parser is a Features -> SExp -> Cuteness function, which spares me most of the type declarations in quibble's/yairchu's solution.
import Text.ParserCombinators.ReadP
main=f(\t->do putStrLn$"Case #"++show t++":";s<-r g;r$print.fst.head.($id=<<s).readP_to_S.d.tail.words=<<g)
d x=do"("<-e;w<-e;c<-do{f<-e;y<-d x;n<-d x;u$if elem f x then y else n}<++u 1.0;e;u$c*read w
f x=do n<-g;mapM x[1..read n]
e=readS_to_P lex
r=f.const
g=getLine
u=return
It used to use Control.Monad's join, forM_ and replicateM, but it turns out it takes less space to redefine them approximately than to import.
I also abandoned the Prelude's readParen in favor of just calling lex before and after. In the current version, there is no need to verify the closing parenthesis: on a valid input it will always be there. On the other hand, it is vital to check the opening one: since the number is only converted after the whole subexpression has been read, a lot of backtracking would be needed to align to the correct parse.
On a theoretical machine with infinite memory and time to spare, the "("<- part might be dropped (4 characters' gain, 308 in total). Unless the call to read just aborts. On mine, the stack just overflows pretty fast.
Java in 467 bytes
This uses the javascript interpreter contained in java 6.
import java.util.*;class D{static{Scanner c=new
Scanner(System.in);int n=c.nextInt(),i=0,l;while(i++<n){l=c.nextInt();String
s="(";while(l-->=0)s+=c.nextLine();System.out.println("Case #"+i+":");l=c.nextInt();while(l-->0)try{c.next();System.out.println(new
javax.script.ScriptEngineManager().getEngineByName("js").eval(s.replace(")","))").replaceAll("\\) *\\(",":(").replaceAll("[a-z]+","*(/ $0 /.test('"+c.nextLine()+" ')?")));}catch(Exception
x){}}System.exit(0);}}
Thanks Varan, Chris and pfn (indirectly) for helping me shorten it.
Please see my other (even shorter!) java answer.
m4 with echo and bc, 339 bytes
This solution is a complete and utter hack, and it gives me a headache. It contains, among other things, escaped double quotes, unescaped double quotes, unescapable backquote and single quote pairs (including a nested pair seven quotes deep), unquoted regular expressions, outsourcing decimal multiplication to bc, and the use of craZy caSE to circumvent macro expansion. But it had to be done, I guess. :p
This adds an "ultimate macroizing" solution to the previous kinds of solutions (iterated loops, recursion w/ lambda mapping, labels and branches, regexp and eval, etc.)
I think a good term for this is "macroni code" :D
(wrapped every 60 characters, for clarity)
define(T,`translit($#)')define(Q,`patsubst($#)')define(I,0)Q
(T(T(T(Q(Q(Q(Q(Q(Q(T(include(A),(),<>),>\s*>,>>),>\s*<,>;),\
([a-z]+\)\s*<,`*ifElsE<rEgExp<P;``````` \1 ''''''';0>;0;<'),
^<,`defiNe<````I';iNcr<I>>\\"Case `#'I:\\"defiNe<`A'''';'),^
[0-9]*),.+ [0-9]+.*,`dEfiNE<```P';`\& '''>A'),<>;N,`(),n'),E
,e),()),.*,`syscmd(`echo "\&"|bc -l')')
Usage: $ cp input.in A; m4 thisfile.m4 > output.out
I'm an m4 n00b, though, having learned it only an hour before writing this. So there's probably room for improvement.
C++ in 698 bytes
Compile with 'g++ -o test source.cpp -include iostream -include vector -include sstream'
#define R(x,f,t) for(int x=f;x<t;x++){
#define S(x) x.size()
#define H string
#define U while
#define I if
#define D cin>>
#define X t.substr(p,S(t))
using namespace std;
int main(){int h,l,n,a,p,Y,W;D h;for(int q=1;q<=h;q++){D l;H s;char c;D c;R(i,0,l)H L;getline(cin,L);R(j,0,S(L))I (L[j]==41||L[j]==40)s+=32;s+=L[j];I(L[j]==40)s+=32;}}D a;printf("Case #%d:\n",q);R(i,0,a)H N;D N;D n;vector<H>f;R(j,0,n)D N;f.push_back(N);}H t=s;float P=1;p=0;U(p<S(t)-1){p=0;U(t[p]!=48&&t[p]!=49)p++;t=X;stringstream T(t);float V;T>>V;H F;T>>F;P*=V;I(F[0]==41)break;Y=0;R(j,0,S(f))if(F==f[j])Y=1;}p=t.find(40)+1;t=X;p=0;I(Y==0){W=1;U (W>0){I(t[p]==40)W++;I(t[p]==41)W--;p++;}t=X;p=0;}}cout<<P<<endl;}}return 0;}
EDIT: I'm sorry; I thought it was ok for the includes (eg, C works even w/o including basic libraries), while I'm sure it would be if I decleared the defines this way.
I'm not home now, and I won't be for some time: I won't be able to modify it. Just ignore my submission.
OCaml in 718 bytes
I'm an OCaml n00b, so this is probably much longer than it needs to be.
Usage: ocaml thisfile.ml <input.in >output.out
#load"str.cma";;open List;;open String;;open Str;;let x=length and
y=Printf.printf and e=global_replace and h=float_of_string and b=regexp and
k=index and r=read_line and a=read_int and w s m c=sub s(c+1)(m-c-1);;for i=1to
a()do y"Case #%d:\n"i;let t=let n=a()in let rec g d j=if j>n then d else
g(d^(r()))(j+1)in e(b" ")""(e(b"\\b")"^"(g""1))and n=a()in let rec z j=if j>n
then()else let q=tl(split(b" ")(r()))in let rec g l j s p=let o=k s '('and c=k
s ')'in if j then let f=w s c o in if contains f '('then let m=k s '^'in let
c=index_from s(m+1)'^'in g 0(mem(w s c m)q)(w s(x s)c)(h(w s m o)*.p)else h f*.p
else if o<c then g(l+1)j(w s(x s)o)p else g(l-1)(l=1)(w s(x s)c)p in y"%f\n"(g
0(0=0)t 1.);z(j+1)in z 1done
Scheme (Guile 1.8)
Here's my version at 278 bytes (with improvements from KirarinSnow to bring it down to 273), after stripping off all the newlines (except ones in string literals, of course). It only works on Guile 1.8 (since in standard Scheme, define is a syntax, not an object, but Guile represents it as an object anyway).
(define ! define)
(!(c f p w . r)(if(null? r)(* p w)(apply c f(* p w)((if(memq(car r)f)cadr caddr)r))))
(!(d . l)(map display l))
(!(r . x)(read))
(! n(r))
(do((i 1(1+ i)))((> i n))(r)(let((t(r)))(d"Case #"i":
")(do((a(r)(1- a)))((= a 0))(r)(d(apply c(map r(iota(r)))1 t)"
"))))
Pure java in 440 bytes
A shorter java solution that doesn't use any eval trick. Can be reduced to 425 by removing System.exit(0) if stderr output is ignored.
import java.util.*;enum A{_;Scanner c,d;float p(String a){return
d.nextFloat()*(d.hasNext("\\D+")?a.contains(' '+d.next()+' ')?p(a)+0*p(a):0*p(a)+p(a):1);}{c=new
Scanner(System.in);for(int n=c.nextInt(),i=0,l;i++<n;){String
s="";for(l=c.nextInt();l-->=0;)s+=c.nextLine();System.out.println("Case #"+i+":");for(l=c.nextInt();l-->0;){c.next();d=new
Scanner(s.replaceAll("[()]"," "));System.out.println(p(c.nextLine()+' '));}}System.exit(0);}}
Haskell, 514 bytes (I suck?).
Based on quibble's solution:
import Control.Monad
import Text.ParserCombinators.Parsec
data F=N|F String(Float,F)(Float,F)
r=return
f=many1 letter>>= \i->w>>d>>= \t->d>>=r.F i t
d=char '('>>w>>many1(oneOf".0123456789")>>= \g->w>>(f<|>r N)>>= \p->char ')'>>w>>r(read g,p)
w=many$oneOf" \n"
g=getLine
l=readLn
m=replicateM
main=l>>= \n->forM_[1..n]$ \t->putStrLn("Case #"++show t++":")>>l>>=(`m`g)>>=(\(Right q)->l>>=(`m`p q)).parse d"".join
z(p,f)=(p*).y f
y N _=1
y(F n t f)x=z(if n`elem`x then t else f)x
p q=fmap(drop 2.words)g>>=print.z q
C in 489 bytes
Code wrapped at 80 chars, there are actually just 3 lines.
Save in a.c and compile with: gcc -w a.c -o a
#define S int I,N;scanf("%d\n",&N);for(I=-1;++I<N;)
#define M 1000
char B[M],Z[M],Q[M]={' '},*F[M],*V;float W[M],H;int J,C,L[M],R[M];t(){V=strtok(0
," \n()");}p(){int U=C++;F[U]=0;if(!V)t();sscanf(V,"%f",W+U);t();if(V&&*V>='a')s
trcpy(Q+1,V),V=0,F[U]=strdup(strcat(Q," ")),L[U]=p(),R[U]=p();return U;}main(){S
{printf("Case #%d:\n",I+1);*B=0;{S strcat(B,gets(Z));}V=strtok(B," \n(");C=0,p()
;{S{strcat(gets(B)," ");for(J=0,H=W[0];F[J];J=strstr(B,F[J])?L[J]:R[J],H*=W[J]);
printf("%f\n",H);};}}}
F#: 759 significant chars (Wow, I'm bad at this ;) )
Minimized version
open System.Text.RegularExpressions
type t=T of float*(string*t*t)option
let rec e=function x,T(w,Some(s,a,b))->e(x,if Set.contains s x then a else b)*w|x,T(w,_)->w
let rec h x=Regex.Matches(x, #"\(|\)|\d\.\d+|\S+")|>Seq.cast<Match>|>Seq.map (fun x -> x.Value)|> Seq.toList
let rec p=function ")"::y->p y|"("::w::x::y->match x with ")"->T(float w,None),y|n->let a,f=p y in let b,g=p f in T(float w,Some(n,a,b)),g
let solve input =
Regex.Matches(input,#"(\(((?<s>\()|[^()]|(?<-s>\)))*\)(?(s)(?!)))\s+\d+\s+((\S+\s\d(.+)?\s*)+)")
|>Seq.cast<Match>
|>Seq.map(fun m->fst(p(h(m.Groups.[1].Value))), [for a in m.Groups.[3].Value.Trim().Split([|'\n'|])->set(a.Split([|' '|]))])
|>Seq.iteri(fun i (r,c)->printfn"Case #%i"(i+1);c|>Seq.iter(fun x->printfn"%.7F"(e(x, r))))
Readable version
open System.Text.RegularExpressions
type decisionTree = T of float * (string * decisionTree * decisionTree) option
let rec eval = function
| x, T(w, Some(s, a, b)) -> eval(x, if Set.contains s x then a else b) * w
| x, T(w, _) -> w
// creates a token stream
let rec tokenize tree =
Regex.Matches(tree, #"\(|\)|\d\.\d+|\S+")
|> Seq.cast<Match>
|> Seq.map (fun x -> x.Value)
|> Seq.toList
// converts token stream into a decisionTree
let rec parse = function
| ")"::xs -> parse xs
| "("::weight::x::xs ->
match x with
| ")" -> T(float weight, None), xs
| name ->
let t1, xs' = parse xs
let t2, xs'' = parse xs'
T(float weight, Some(name, t1, t2)), xs''
// uses regex to transform input file into a Seq<decisionTree, list<set<string>>, which each item in our
// list will be tested against the decisionTree
let solve input =
Regex.Matches(input, #"(\(((?<s>\()|[^()]|(?<-s>\)))*\)(?(s)(?!)))\s+\d+\s+((\S+\s\d(.+)?\s*)+)")
|> Seq.cast<Match>
|> Seq.map (fun m -> fst(parse(tokenize(m.Groups.[1].Value))), [for a in m.Groups.[3].Value.Trim().Split([|'\n'|]) -> set(a.Split([|' '|])) ])
|> Seq.iteri (fun i (tree, testCases) ->
printfn "Case #%i" (i+1)
testCases |> Seq.iter (fun testCase -> printfn "%.7F" (eval (testCase, tree)))
)
R in 280 bytes
Note: On the standard distribution of R (as of v. 2.9.2), this program does not pass the large input and fails on just Case 28 (which is nested to 99 levels), generating a "contextstack overflow". To fix this, modify the line in src/main/gram.c that reads
#define CONTEXTSTACK_SIZE 50
and replace the 50 with something like 500. Then recompile. Et voilà!
n=0
g=gsub
eval(parse(text=g('[^
]* [0-9]+( [^
]*|
)','f=c(\\1)
cat(eval(d),"
")
',g('
\\(','
cat("Case #",n<-n+1,":
",sep="")
d=expression(',g('" "','","',g(')\\s*\\(',',',g(' *("[a-z]+")\\s*\\(','*ifelse(\\1%in%f,',g('([a-z]+)','"\\1"',paste(readLines('A'),collapse='
')))))))))
Usage (requires renaming input): cp input.in A; R -q --slave -f thisfile.R >output.out

Code Golf: Hourglass

Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
The challenge
The shortest code by character count to output an hourglass according to user input.
Input is composed of two numbers: First number is a greater than 1 integer that represents the height of the bulbs, second number is a percentage (0 - 100) of the hourglass' capacity.
The hourglass' height is made by adding more lines to the hourglass' bulbs, so size 2 (the minimal accepted size) would be:
_____
\ /
\ /
/ \
/___\
Size 3 will add more lines making the bulbs be able to fit more 'sand'.
Sand will be drawn using the character x. The top bulb will contain N percent 'sand' while the bottom bulb will contain (100 - N) percent sand, where N is the second variable.
'Capacity' is measured by the amount of spaces () the hourglass contains. Where percentage is not exact, it should be rounded up.
Sand is drawn from outside in, giving the right side precedence in case percentage result is even.
Test cases
Input:
3 71%
Output:
_______
\x xx/
\xxx/
\x/
/ \
/ \
/__xx_\
Input:
5 52%
Output:
___________
\ /
\xx xx/
\xxxxx/
\xxx/
\x/
/ \
/ \
/ \
/ xxx \
/xxxxxxxxx\
Input:
6 75%
Output:
_____________
\x x/
\xxxxxxxxx/
\xxxxxxx/
\xxxxx/
\xxx/
\x/
/ \
/ \
/ \
/ \
/ \
/_xxxxxxxxx_\
Code count includes input/output (i.e full program).
C/C++, a dismal 945 characters...
Takes input as parameters:
a.out 5 52%
#include<stdio.h>
#include<memory.h>
#include<stdlib.h>
#define p printf
int h,c,*l,i,w,j,*q,k;const char*
z;int main(int argc,char**argv)
{h=atoi(argv[1]);c=(h*h*atoi(
argv[2])+99)/100;l=new int[
h*3];for(q=l,i=0,w=1;i<h;
i++,c=(c-w)&~((c-w)>>31
),w+=2)if(c>=w){*q++=
0;*q++ =0;* q++=w;}
else {*q++=(c+1)/
2;*q++=w-c;*q++
=c/2;}p("_");
for(i=0;i<h
;i ++)p (
"__");p
("\n"
);q
=
l+h
*3-1;
for (i=
--h;i>=0;
i--){p("%*"
"s\\",h-i,"")
; z= "x\0 \0x";
for(k=0;k<3;k++,q
--,z+=2)for(j=0;j<*
q;j++)p(z);q-=0;p("/"
"\n");}q=l;for(i=0;i<=h
;i++){z =i==h? "_\0x\0_":
" \0x\0 ";p("%*s/",h-i,"");
for(k=0;k<3;k++,q++,z+=2)for(
j=0;j<*q;j++)p(z);p("\\\n") ;}}
...and the decrypted version of this for us mere humans:
#include <stdio.h>
#include <memory.h>
#include <stdlib.h>
#define p printf
int h, c, *l, i, w, j, *q, k;
const char *z;
int main(int argc, char** argv)
{
h = atoi(argv [1]);
c = (h*h*atoi(argv[2])+99)/100;
l = new int[h*3];
for (q = l,i = 0,w = 1; i<h; i++,c = (c-w)&~((c-w)>>31),w += 2) {
if (c>=w) {
*q++ = 0;
*q++ = 0;
*q++ = w;
} else {
*q++ = (c+1)/2;
*q++ = w-c;
*q++ = c/2;
}
}
p("_");
for (i = 0; i<h; i++) {
p("__");
}
p("\n");
q = l+h*3-1;
for (i = --h; i>=0; i--) {
p("%*s\\",h-i,"");
z = "x\0 \0x";
for (k = 0; k<3; k++,q--,z += 2) {
for (j = 0; j<*q; j++) {
p(z);
}
}
p("/\n");
}
q = l;
for (i = 0; i<=h; i++) {
z = i==h ? "_\0x\0_" : " \0x\0 ";
p("%*s/",h-i,"");
for (k = 0; k<3; k++,q++,z += 2) {
for (j = 0; j<*q; j++) {
p(z);
}
}
p("\\\n") ;
}
}
Perl, 191 char
205 199 191 chars.
$S=-int((1-.01*pop)*($N=pop)*$N)+$N*$N;$S-=$s=$S>++$r?$r:$S,
$\=$/.$"x$N."\\".x x($v=$s/2).$"x($t=$r++-$s).x x($w=$v+.5)."/$\
".$"x$N."/".($^=$N?$":_)x$w.x x$t.$^x$v."\\"while$N--;print$^x++$r
Explicit newline required between the 2nd and 3rd lines.
And with help of the new Acme::AsciiArtinator module:
$S=-int((1-.01*pop)*($N=pop
) *
$ N
) +
$ N
*$N;( ${B},$
F,${x})=qw(\\ / x
);while($N){;/l
ater/g;$S-=$s
=$S>++$r?$r
:$S;'than
you';#o
=(" "
x--
$ N
. $
B .
x x
( $
v =
$ s
/ 2
) .$"x($t= $
r++-$s).x x($w=$v+.5)
.$F,#o,$"x$N.$F.($^=$N?
$":_)x$w.x x$t.$^x$v.$B);
$,=$/}print$^x++$r,#o;think
Golfscript - 136 Chars (Fits in a Tweet)
Be sure not to have a newline after the % for the input
eg
$ echo -n 3 71%|./golfscript.rb hourglass.gs
You can animate the hourglass like this:
$ for((c=100;c>=0;c--));do echo -n "15 $c%"|./golfscript.rb hourglass.gs;echo;sleep 0.1;done;
Golfscript - 136 Chars
Make sure you don't save it with an extra newline on the end or it will print an extra number
);' ': /(~:
;0=~100.#-
.**\/:t;'_':&&
*.n
,{:y *.'\\'+{[&'x':x]0t(:t>=}:S~
(y-,{;S\+S+.}%;'/'++\+}%.{&/ *}%\-1%{-1%x/ *&/x*}%) /&[*]++n*
Golfscript - 144 Chars
);' ':|/(~:^.*:X
;0=~100.#-X*\/
X'x':x*'_':&
#*+:s;&&&+
^*n^,{:y
|*.[92
]+{s
[)
\#
:s;]
}:S~^(
y-,{;S\+
S+.}%;'/'+
+\+}%.{&/|*}
%\-1%{-1%x/|*&
/x*}%)|/&[*]++n*
How it works
First do the top line of underscores which is 2n+1
Create the top half of the hourglass, but use '_' chars instead of spaces, so for the 3 71% we would have.
\x__xx/
\xxx/
\x/
Complete the top half by replacing the "_" with " " but save a copy to generate the bottom half
The bottom half is created by reversing the whole thing
/x\
/xxx\
/xx__x\
Replacing all the 'x' with ' ' and then then '_' with 'x'
/ \
/ \
/ xx \
Finally replace the ' ' in the bottom row with '_'
/ \
/ \
/__xx_\
Roundabout but for me, the code turned out shorter than trying to generate both halves at once
Python, 213 char
N,p=map(int,raw_input()[:-1].split())
S=N*N-N*N*(100-p)/100
_,e,x,b,f,n=C='_ x\/\n'
o=""
r=1
while N:N-=1;z=C[N>0];s=min(S,r);S-=s;t=r-s;v=s/2;w=s-v;r+=2;o=n+e*N+b+x*v+e*t+x*w+f+o+n+e*N+f+z*w+x*t+z*v+b
print _*r+o
Rebmu: 188 chars
rJ N 0% rN Wad1mpJ2 S{ \x/ }D0 Hc&[u[Z=~wA Qs^RTkW[isEL0c[skQdvK2][eEV?kQ[tlQ]]pcSeg--B0[eZ1 5]3]prRJ[si^DspSCsQfhS]eZ1[s+DcA+wMPc2no]]]Va|[mpAj**2]prSI^w{_}Ls+W2 h1tiVsb1n -1 chRVs{_}hLceVn1
It's competitive with the shorter solutions here, though it's actually solving the problem in a "naive" way. More or less it's doing the "sand physics" instead of exploiting symmetries or rotating matrices or anything.
H defines a function for printing a half of an hourglass, to which you pass in a number which is how many spaces to print before you start printing "x" characters. If you're on the top half, the sand string is constructed by alternating appends to the head and the tail. If you're on the bottom it picks the insertion source by skipping into the middle of the string. Commented source available at:
http://github.com/hostilefork/rebmu/blob/master/examples/hourglass.rebmu
But the real trick up Rebmu's sleeve is it's a thin dialect that doesn't break any of the parsing rules of its host language (Rebol). You can turn this into a Doomsday visualization by injecting ordinary code right in the middle, as long you code in lowercase:
>> rebmu [rJ birthday: to-date (ask "When were you born? ") n: (21-dec-2012 - now/date) / (21-dec-2012 - birthday) Wad1mpJ2 S{ \x/ }D0 Hc~[u[Ze?Wa Qs^RTkW[isEL0c[skQdvK2][eEV?kQ[tlQ]]pcSeg--B0[eZ1 5]3]prRJ[si^DspSCsQfhS]eZ1[s+DcA+wMPc2no]]]Va|[mpAj**2]prSI^w{_}Ls+W2h1tiVsb1n -1 chRVs{_}hLceVn1]
Input Integer: 10
When were you born? 23-May-1974
_____________________
\ /
\ /
\ /
\ /
\ /
\ /
\ /
\x xx/
\xxx/
\x/
/ \
/ \
/ xx \
/xxxxxxx\
/xxxxxxxxx\
/xxxxxxxxxxx\
/xxxxxxxxxxxxx\
/xxxxxxxxxxxxxxx\
/xxxxxxxxxxxxxxxxx\
/xxxxxxxxxxxxxxxxxxx\
O noes! :)
(Note: A major reason I'm able to write and debug Rebmu programs is because I can break into ordinary coding at any point to use the existing debugging tools/etc.)
Haskell. 285 characters. (Side-effect-free!)
x n c=h s++'\n':reverse(h(flip s)) where h s=r w '-'++s '+' b(w-2)0 p;w=(t n);p=d(n*n*c)100
s x n i o p|i>0='\n':l++s x n(i-2)(o+1)(max(p-i)0)|True=[] where l=r o b++'\\':f d++r(i#p)n++f m++'/':r o b;f g=r(g(i-(i#p))2)x
b=' '
r=replicate
t n=1+2*n
d=div
(#)=min
m=(uncurry(+).).divMod
Run with e.g. x 5 50
A c++ answer, is 592 chars so far, still having reasonable formatting.
#include<iostream>
#include<string>
#include<cstdlib>
#include<cmath>
using namespace std;
typedef string S;
typedef int I;
typedef char C;
I main(I,C**v){
I z=atoi(v[1]),c=z*z,f=ceil(c*atoi(v[2])/100.);
cout<<S(z*2+1,'_')<<'\n';
for(I i=z,n=c;i;--i){
I y=i*2-1;
S s(y,' ');
C*l=&s[0];
C*r=&s[y];
for(I j=0;j<y;++j)
if(n--<=f)*((j&1)?l++:--r)='x';
cout<<S(z-i,' ')<<'\\'<<s<<"/\n";
}
for(I i=1,n=c-f;i<=z;++i){
I y=i*2-1;
S s(y,'x');
C*l=&s[0];
C*r=&s[y];
for(I j=0;j<y;++j)
if(n++<c)*(!(j&1)?l++:--r)=(i==z)?'_':' ';
cout<<S(z-i,' ')<<'/'<<s<<"\\\n";
}
}
If i decide to just forget formatting it reasonably, i can get it as low as 531:
#include<iostream>
#include<string>
#include<cstdlib>
#include<cmath>
using namespace std;typedef string S;typedef int I;typedef char C;I main(I,C**v){I z=atoi(v[1]),c=z*z,f=ceil(c*atoi(v[2])/100.);cout<<S(z*2+1,'_')<<'\n';for(I i=z,n=c;i;--i){I y=i*2-1;S s(y,' ');C*l=&s[0];C*r=&s[y];for(I j=0;j<y;++j)if(n--<=f)*((j&1)?l++:--r)='x';cout<<S(z-i,' ')<<'\\'<<s<<"/\n";}for(I i=1,n=c-f;i<=z;++i){I y=i*2-1;S s(y,'x');C*l=&s[0];C*r=&s[y];for(I j=0;j<y;++j)if(n++<c)*(!(j&1)?l++:--r)=(i==z)?'_':' ';cout<<S(z-i,' ')<<'/'<<s<<"\\\n";}}
Bash: 639 - 373 characters
I thought I would give bash a try (haven't seen much code-golfing in it). (my version: GNU bash, version 3.2.48(1)-release (i486-pc-linux-gnu))
Based on Mobrule's nice python answer.
Optimizations must still be available, so all suggestions are welcome!
Start from the command line, e.g. : ./hourglass.sh 7 34%
function f () { for i in `seq $1`;do printf "$2";done; }
N=$1;S=$[$1*$1-$1*$1*$[100-${2/\%/}]/100]
b='\';o=$b;n="\n";r=1;while [ $N -gt 0 ];do
N=$[N-1];z=" ";s=$r;[ $N -eq 0 ]&& z=_;[ $S -lt $r ]&& s=$S
S=$[S-s];t=$[r-s];v=$[s/2];w=$[s-v];r=$[r+2]
o=$n`f $N " "`$b`f $v x;f $t " ";f $w x`/$o$b$n`f $N " "`/`f $w "$z";f $t x;f $v "$z"`$b
done;f $r _;echo -e "${o/\/\\\\//}"
Java; 661 characters
public class M{public static void main(String[] a){int h=Integer.parseInt(a[0]);int s=(int)Math.ceil(h*h*Integer.parseInt(a[1])/100.);r(h,h-1,s,true);r(h,h-1,s,false);}static void r(int h,int c,int r,boolean t){if(c<0)return;int u=2*(h-c)-1;if(t&&c==h-1)p(2*h+1,0,'_','_',true,0,false);int z=r>=u?u:r;r-=z;if(t)r(h,c-1,r,true);p(u,z,t?'x':((c==0)?'_':' '),t?' ':'x',t,c,true);if(!t)r(h,c-1,r,false);}static void p(int s,int n,char o,char i,boolean t,int p,boolean d){int f=(s-n);int q=n/2+(!t&&(f%2==0)?1:0);int e=q+f;String z = "";int j;for(j=0;j<p+4;j++)z+=" ";if(d)z+=t?'\\':'/';for(j=0;j<s;j++)z+=(j>=q&&j<e)?i:o;if(d)z+=t?'/':'\\';System.out.println(z);}}
I need to find a better set of golf clubs.
PHP - 361
<?$s=$argv[1];$x='str_pad';$w=$s*2-1;$o[]=$x('',$w+2,'_');
$r=$s*ceil($w/2);$w=$r-($r*substr($argv[2],0,-1)/100);$p=0;
$c=-1;while($s){$k=$s--*2-1;$f=$x($x('',min($k,$w),' '),$k,'x',2);
$g=$x($x('',min($k,$w),'x'),$k,' ',2);$w-=$k;$o[]=$x('',$p)."\\$f/";
$b[]=$x('',$p++)."/$g\\";}$b[0]=str_replace(' ','_',$b[0]);
krsort($b);echo implode("\n",array_merge($o,$b));?>
Python - 272 chars
X,p=map(int,raw_input()[:-1].split())
k=X*X;j=k*(100-p)/100
n,u,x,f,b,s='\n_x/\ '
S=list(x*k+s*j).pop;T=list(s*k+u*(2*X-j-1)+x*j).pop
A=B=""
for y in range(X):
r=S();q=T()
for i in range(X-y-1):r=S()+r+S();q+=T();q=T()+q
A+=n+s*y+b+r+f;B=n+s*y+f+q+b+B
print u+u*2*X+A+B
Exabyte18's java converted to C#, 655 bytes:
public class M {public static void Main(){int h = Convert.ToInt32(Console.ReadLine());
int s = Convert.ToInt32(h * h * Convert.ToInt32(Console.ReadLine()) / 100);r(h,h-1,s,true);
r(h,h-1,s,false);Console.ReadLine();}static void r(int h, int c, int r, bool t){
if(c<0) return;int u=2*(h-c)-1;if (t&&c==h-1)p(2*h+1,0,'_','_',true,0,false);
int z=r>=u?u:r; r-=z;if (t)M.r(h,c-1,r,true); p(u,z,t?'x':((c==0)?'_':' '), t?' ':'x',t,c,true);
if(!t)M.r(h,c-1,r,false);}static void p(int s, int n, char o, char i, bool t, int p, bool d)
{int f=(s-n);int q=n/2+(!t&&(f%2==0)?1:0);int e=q+f;string z="";int j;for(j=0;j<p+4;j++) z+=" ";if(d)z+=t?'\\':'/';
for (j=0;j<s;j++) z+=(j>=q&&j<e)?i:o; if(d)z+=t?'/':'\\';Console.WriteLine(z);}}
Ruby, 297 254 (after compression)
Run both with ruby -a -p f.rb
n,p = $F.map{|i|i.to_i}
r="\n"
y=''
g,s,u,f,b=%w{x \ _ / \\}
$> << u*2*n+u+r # draw initial underbar line
a=u
c=100.0/n/n # amount of sand a single x represents
e = 100.0 # percentage floor to indicate sand at this level
n.times{ |i|
d=2*n-1-2*i # number of spaces at this level
e-= c*d # update percentage floor
x = [((p - e)/c+0.5).to_i,d].min
x = 0 if x<0
w = x/2 # small half count
z = x-w # big half count
d = d-x # total padding count
$> << s*i+b+g*w+s*d+g*z+f+r
y=s*i+f+a*z+g*d+a*w+b+r+y
a=s
}
$_=y
Ruby, 211
This is mobrule's tour de force, in Ruby. (And still no final newline. :-)
m,p=$F.map{|i|i.to_i}
q=m*m-m*m*(100-p)/100
_,e,x,b,f=%w{_ \ x \\ /}
n="\n"
o=''
r=1
while m>0
m-=1
z=m>0?e:_
s=q<r ?q:r
q-=s
t=r-s
v=s/2
w=s-v
r=r+2
o=n+e*m+b+x*v+e*t+x*w+f+o+n+e*m+f+z*w+x*t+z*v+b
end
$_=_*r+o