Code Golf - π day - 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
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}

Related

Creating a function in assembly language (TASM)

I wanted to print the first 20 numbers using loop.
Printing the first nine numbers is absolutely fine as the hexadecimal and decimal codes are the same, but from the 10th number I had to convert each number into its appropriate code and then convert it and store it to string and eventually display it
That is,
If (NUMBER > 9)
ADD 6D
;10d = 0ah --(+6)--> 16d = 10h
IF NUMBER IS > 19
ADD 12D
;20d = 14h --(+12)--> 32d = 20h
Then rotating and shifting each number to get the desired output number, that is,
DAA # let al = 74h = 0111.0100
XOR AH,AH # ah = 0 (Just in case it wasn't)
# ax = 0000.0000.0111.0100
ROR AX,4 # ax = 0100.0000.0000.0111 = 4007h
SHR AH,4 # ax = 0000.0100.0000.0111 = 0407h
ADD AX,3030h # ax = 0011.0100.0011.0111 = 3437h = ASCII "74" (Reversed due to little endian)
And then storing the result in to the string and displaying it, that is,
MOV BX,OFFSET Result ;Let Result is an empty string
MOV byte ptr[BX],5 ;Size of the string
MOV byte ptr[BX+4],'$' ;String terminator
MOV byte ptr[BX+3],AH ;storing number
MOV byte ptr[BX+2],AL
MOV DX,BX
ADD DX,02 ;Displaying the result
MOV AH,09H ;Interrupt 21 service to display string
INT 21H
And here is the complete code with proper commenting,
MOV CX,20 ;Number of iterations
MOV DX,0 ;First value of the sequence
L1:
PUSH DX
ADD DX,30H ; 30H is equal to 0 in hexadecimal , 31H = 1 and so on
MOV AH,02H ; INTERRUPT Service to print the DX content
INT 21H
POP DX
ADD DX,1
CMP DX,09 ; if number is > 9 i.e 0A then go to L2
JA L2
LOOP L1
L2:
PUSH DX
MOV AX,DX
CMP AX,14H ;If number is equal to 14H(20) then Jump to L3
JE L3
ADD AX,6D ;If less than 20 then add 6D
XOR AH,AH ;Clear the content of AH
ROR AX,4 ;Rotating and Shifting for to properly store
SHR AH,4
ADC AX,3030h
MOV BX,OFFSET Result
MOV byte ptr[BX],5
MOV byte ptr[BX+4],'$'
MOV byte ptr[BX+3],AH
MOV byte ptr[BX+2],AL
MOV DX,BX
ADD DX,02
MOV AH,09H
INT 21H
POP DX
ADD DX,1
LOOP L2
;If the number is equal to 20 come here, ->
; Every step is repeated here just to change 6D to 12D
L3:
ADD AX,12D
XOR AH,AH
ROR AX,1
ROR AX,1
ROR AX,1
ROR AX,1
SHR AH,1
SHR AH,1
SHR AH,1
SHR AH,1
ADC AX,3030h
MOV BX,OFFSET Result
MOV byte ptr[BX],5
MOV byte ptr[BX+4],'$'
MOV byte ptr[BX+3],AH
MOV byte ptr[BX+2],AL
MOV DX,BX
ADD DX,02
MOV AH,09H
INT 21H
Is there any proper way to do it, creating a function and using if/else (jumps) to get the desired output rather than repeating the code again and again?
PSEUDO CODE:
VAR = 6
IF Number is > 9
ADD AX,VAR
Else IF Number is > 19
ADD AX,(VAR*2)
ELSE IF NUMBER is > 29
ADD AX,(VAR*3)
So you just want to print 0 ... 20 as ASCII characters? It looks like you understand that the numerals are identified as 0x30 ... 0x39 for '0' to '9', so you could use integer division to generate the character for the tens digit:
I usually work with C but conversion to assembler shouldn't be too complicated since these are all fundamental operations and there are no function calls.
int i_value = 29;
int i_tens = i_value/10; //Integer division! 29/10 = 2, save for later use
char c_tens = '0' + i_tens;
char c_ones = '0' + i_value-(10*i_tens); // Subtract N*10 from value
The output will be c_tens = 0x32, c_ones = 0x39. You should be able to wrap this inside of a loop pretty easily using a pair of registers.
Pseudocode
regA <- num_iterations //For example, 20
regB <- 0 //Initialize counter register
LOOP:
//Do conversion for the current iteration.
//Manipulate bytes for output as necessary.
regB <- regB +1
branch not equal regA, regB LOOP
The following code counts from 0 up to 99 (ax contains the ASCII number):
count proc
mov cx, 100 ; loop runs the times specified in the cx register
xor bx, bx ; set counter to zero
print:
mov ax, bx
aam ; Converts binary to unpacked BCD
xor ax, 3030h ; Converts upacked BCD to ASCII
; Print here (ax now contains the numer in ASCII representation)
inc bx ; Increase counter
loop print
ret
count endp

Code Golf: Rotating Maze

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.
Code Golf: Rotating Maze
Make a program that takes in a file consisting of a maze. The maze has walls given by #. The maze must include a single ball, given by a o and any number of holes given by a #. The maze file can either be entered via command line or read in as a line through standard input. Please specify which in your solution.
Your program then does the following:
1: If the ball is not directly above a wall, drop it down to the nearest wall.
2: If the ball passes through a hole during step 1, remove the ball.
3: Display the maze in the standard output (followed by a newline).
Extraneous whitespace should not be displayed.
Extraneous whitespace is defined to be whitespace outside of a rectangle
that fits snugly around the maze.
4: If there is no ball in the maze, exit.
5: Read a line from the standard input.
Given a 1, rotate the maze counterclockwise.
Given a 2, rotate the maze clockwise.
Rotations are done by 90 degrees.
It is up to you to decide if extraneous whitespace is allowed.
If the user enters other inputs, repeat this step.
6: Goto step 1.
You may assume all input mazes are closed. Note: a hole effectively acts as a wall in this regard.
You may assume all input mazes have no extraneous whitespace.
The shortest source code by character count wins.
Example written in javascript:
http://trinithis.awardspace.com/rotatingMaze/maze.html
Example mazes:
######
#o ##
######
###########
#o #
# ####### #
#### #
#########
###########################
# #
# # # #
# # # ##
# # ####o####
# # #
# #
# #########
# #
######################
Perl, 143 (128) char
172 152 146 144 143 chars,
sub L{my$o;$o.=$/while s/.$/$o.=$&,""/meg;$_=$o}$_.=<>until/
/;{L;1while s/o / o/;s/o#/ #/;L;L;L;print;if(/o/){1-($z=<>)||L;$z-2||L&L&L;redo}}
Newlines are significant.
Uses standard input and expects input to contain the maze, followed by a blank line, followed by the instructions (1 or 2), one instruction per line.
Explanation:
sub L{my$o;$o.="\n"while s/.$/$o.=$&,""/meg;$_=$o}
L is a function that uses regular expressions to rotate the multi-line expression $_ counterclockwise by 90 degrees. The regular expression was used famously by hobbs in my favorite code golf solution of all time.
$_.=<>until/\n\n/;
Slurps the input up to the first pair of consecutive newlines (that is, the maze) into $_.
L;1 while s/o / o/;s/o#/ */;
L;L;L;print
To drop the ball, we need to move the o character down one line is there is a space under it. This is kind of hard to do with a single scalar expression, so what we'll do instead is rotate the maze counterclockwise, move the ball to the "right". If a hole ever appears to the "right" of the ball, then the ball is going to fall in the hole (it's not in the spec, but we can change the # to an * to show which hole the ball fell into). Then before we print, we need to rotate the board clockwise 90 degrees (or counterclockwise 3 times) so that down is "down" again.
if(/o/) { ... }
Continue if there is still a ball in the maze. Otherwise the block will end and the program will exit.
1-($z=<>)||L;$z-2||L+L+L;redo
Read an instruction into $z. Rotate the board counterclockwise once for instruction "1" and three times for instruction "2".
If we used 3 more characters and said +s/o[#*]/ */ instead of ;s/o#/ */, then we could support multiple balls.
A simpler version of this program, where the instructions are "2" for rotating the maze clockwise and any other instruction for rotating counterclockwise, can be done in 128 chars.
sub L{my$o;$o.=$/while s/.$/$o.=$&,""/meg;$_=$o}$_.=<>until/
/;L;{1while s/o / o/+s/o#/ #/;L,L,L;print;if(/o/){2-<>&&L,L;redo}}
GolfScript - 97 chars
n/['']/~{;(#"zip-1%":|3*~{{." o"/"o "*"#o"/"# "*.#>}do}%|~.n*."o"/,(}{;\~(2*)|*~\}/\[n*]+n.+*])\;
This isn't done as well as I hoped (maybe later).
(These are my notes and not an explanation)
n/['']/~ #[M I]
{
;(# #[I c M]
"zip-1%":|3*~ #rotate
{{." o"/"o "*"#o"/"# "*.#>}do}% #drop
|~ #rotate back
.n* #"display" -> [I c M d]
."o"/,( #any ball? -> [I c M d ?]
}{ #d is collected into an array -> [I c M]
;\~(2*)|*~ #rotate
\ #stack order
}/
\[n*]+n.+*])\; #output
Rebmu: 298 Characters
I'm tinkering with with my own experiment in Code Golf language design! I haven't thrown matrix tricks into the standard bag yet, and copying GolfScript's ideas will probably help. But right now I'm working on refining the basic gimmick.
Anyway, here's my first try. The four internal spaces are required in the code as it is, but the line breaks are not necessary:
.fFS.sSC L{#o#}W|[l?fM]H|[l?m]Z|[Tre[wH]iOD?j[rvT]t]
Ca|[st[xY]a KrePC[[yBKx][ntSBhXbkY][ntSBhYsbWx][xSBwY]]ntJskPCmFkSk]
Ga|[rtYsZ[rtXfZ[TaRE[xY]iTbr]iTbr]t]B|[gA|[ieSlFcA[rnA]]]
MeFI?a[rlA]aFV[NbIbl?n[ut[++n/2 TfCnIEfLtBRchCbSPieTHlTbrCHcNsLe?sNsZ]]
gA|[TfCaEEfZfA[prT][pnT]nn]ulBbr JmoADjPC[3 1]rK4]
It may look like a cat was on my keyboard. But once you get past a little space-saving trick (literally saving spaces) called "mushing" it's not so bad. The idea is that Rebmu is not case sensitive, so alternation of capitalization runs is used to compress the symbols. Instead of doing FooBazBar => foo baz bar I apply distinct meanings. FOObazBAR => foo: baz bar (where the first token is an assignment target) vs fooBAZbar => foo baz bar (all ordinary tokens).
When the unmush is run, you get something more readable, but expanded to 488 characters:
. f fs . s sc l: {#o#} w: | [l? f m] h: | [l? m] z: | [t: re [w h] i od?
j [rv t] t] c: a| [st [x y] a k: re pc [[y bk x] [nt sb h x bk y] [nt sb
h y sb w x] [x sb w y]] nt j sk pc m f k s k] g: a| [rt y s z [rt x f z
[t: a re [x y] i t br] i t br] rn t] b: | [g a| [ie s l f c a [rn a]]]
m: e fi? a [rl a] a fv [n: b i bl? n [ut [++ n/2 t: f c n ie f l t br
ch c b sp ie th l t br ch c n s l e? s n s z]] g a| [t: f c a ee f z f
a [pr t] [pn t] nn] ul b br j: mo ad j pc [3 1] r k 4]
Rebmu can run it expanded also. There are also verbose keywords as well (first instead of fs) and you can mix and match. Here's the function definitions with some comments:
; shortcuts f and s extracting the first and second series elements
. f fs
. s sc
; character constants are like #"a", this way we can do fL for #"#" etc
L: {#o#}
; width and height of the input data
W: | [l? f m]
H: | [l? m]
; dimensions adjusted for rotation (we don't rotate the array)
Z: | [t: re [w h] i od? j [rv t] t]
; cell extractor, gives series position (like an iterator) for coordinate
C: a| [
st [x y] a
k: re pc [[y bk x] [nt sb h x bk y] [nt sb h y sb w x] [x sb w y]] nt j
sk pc m f k s k
]
; grid enumerator, pass in function to run on each cell
G: a| [rt y s z [rt x f z [t: a re [x y] i t br] i t br] t]
; ball position function
B: | [g a| [ie sc l f c a [rn a]]]
W is the width function and H is the height of the original array data. The data is never rotated...but there is a variable j which tells us how many 90 degree right turns we should apply.
A function Z gives us the adjusted size for when rotation is taken into account, and a function C takes a coordinate pair parameter and returns a series position (kind of like a pointer or iterator) into the data for that coordinate pair.
There's an array iterator G which you pass a function to and it will call that function for each cell in the grid. If the function you supply ever returns a value it will stop the iteration and the iteration function will return that value. The function B scans the maze for a ball and returns coordinates if found, or none.
Here's the main loop with some commenting:
; if the command line argument is a filename, load it, otherwise use string
m: e fi? a [rl a] a
; forever (until break, anyway...)
fv [
; save ball position in n
n: B
; if n is a block type then enter a loop
i bl? n [
; until (i.e. repeat until)
ut [
; increment second element of n (the y coordinate)
++ n/2
; t = first(C(n))
t: f C n
; if-equal(first(L), t) then break
ie f l t br
; change(C(B), space)
ch C B sp
; if-equal(third(L),t) then break
ie th L t br
; change(C(n), second(L))
ch C n s L
; terminate loop if "equals(second(n), second(z))"
e? s n s z
]
]
; iterate over array and print each line
g a| [t: f c a ee f z f a [pr t] [pn t] nn]
; unless the ball is not none, we'll be breaking the loop here...
ul b br
; rotate according to input
j: mo ad j pc [3 1] r k 4
]
There's not all that much particularly clever about this program. Which is part of my idea, which is to see what kind of compression one could get on simple, boring approaches that don't rely on any tricks. I think it demonstrates some of Rebmu's novel potential.
It will be interesting to see how a better standard library could affect the brevity of solutions!
Latest up-to-date commented source available on GitHub: rotating-maze.rebmu
Ruby 1.9.1 p243
355 353 characters
I'm pretty new to Ruby, so I'm sure this could be a lot shorter - theres probably some nuances i'm missing.
When executed, the path to the map file is the first line it reads. I tried to make it part of the execution arguments (would have saved 3 characters), but had issues :)
The short version:
def b m;m.each_index{|r|i=m[r].index(?o);return r,i if i}end;def d m;x,y=b m;z=x;
while z=z+1;c=m[z][y];return if c==?#;m[z-1][y]=" "; return 1 if c==?#;m[z][y]=?o;end;end;
def r m;m.transpose.reverse;end;m=File.readlines(gets.chomp).map{|x|x.chomp.split(//)};
while a=0;w=d m;puts m.map(&:join);break if w;a=gets.to_i until 0<a&&a<3;
m=r a==1?m:r(r(m));end
The verbose version:
(I've changed a bit in the compressed version, but you get the idea)
def display_maze m
puts m.map(&:join)
end
def ball_pos m
m.each_index{ |r|
i = m[r].index("o")
return [r,i] if i
}
end
def drop_ball m
x,y = ball_pos m
z=x
while z=z+1 do
c=m[z][y]
return if c=="#"
m[z-1][y]=" "
return 1 if c=="#"
m[z][y]="o"
end
end
def rot m
m.transpose.reverse
end
maze = File.readlines(gets.chomp).map{|x|x.chomp.split(//)}
while a=0
win = drop_ball maze
display_maze maze
break if win
a=gets.to_i until (0 < a && a < 3)
maze=rot maze
maze=rot rot maze if a==1
end
Possible improvement areas:
Reading the maze into a clean 2D array (currently 55 chars)
Finding and returning (x,y) co-ordinates of the ball (currently 61 chars)
Any suggestions to improve are welcome.
Haskell: 577 509 527 244 230 228 chars
Massive new approach: Keep the maze as a single string!
import Data.List
d('o':' ':x)=' ':(d$'o':x)
d('o':'#':x)=" *"++x
d(a:x)=a:d x
d e=e
l=unlines.reverse.transpose.lines
z%1=z;z%2=l.l$z
t=putStr.l.l.l
a z|elem 'o' z=t z>>readLn>>=a.d.l.(z%)|0<1=t z
main=getLine>>=readFile>>=a.d.l
Nods to #mobrule's Perl solution for the idea of dropping the ball sideways!
Python 2.6: ~ 284 ~ characters
There is possibly still room for improvement (although I already got it down a lot since the first revisions).
All comments or suggestions more then welcome!
Supply the map file on the command line as the first argument:
python rotating_maze.py input.txt
import sys
t=[list(r)[:-1]for r in open(sys.argv[1])]
while t:
x=['o'in e for e in t].index(1);y=t[x].index('o')
while t[x+1][y]!="#":t[x][y],t[x+1][y]=" "+"o#"[t[x+1][y]>" "];x+=1
for l in t:print''.join(l)
t=t[x][y]=='o'and map(list,(t,zip(*t[::-1]),zip(*t)[::-1])[input()])or 0
C# 3.0 - 650 638 characters
(not sure how newlines being counted)
(leading whitespace for reading, not counted)
using System.Linq;
using S=System.String;
using C=System.Console;
namespace R
{
class R
{
static void Main(S[]a)
{
S m=S.Join("\n",a);
bool u;
do
{
m=L(m);
int b=m.IndexOf('o');
int h=m.IndexOf('#',b);
b=m.IndexOf('#',b);
m=m.Replace('o',' ');
u=(b!=-1&b<h|h==-1);
if (u)
m=m.Insert(b-1,"o").Remove(b,1);
m=L(L(L(m)));
C.WriteLine(m);
if (!u) return;
do
{
int.TryParse(C.ReadLine(),out b);
u=b==1|b==2;
m=b==1?L(L(L(m))):u?L(m):m;
}while(!u);
}while(u);
}
static S L(S s)
{
return S.Join("\n",
s.Split('\n')
.SelectMany(z => z.Select((c,i)=>new{c,i}))
.GroupBy(x =>x.i,x=>x.c)
.Select(g => new S(g.Reverse().ToArray()))
.ToArray());
}
}
}
Reads from commandline, here's the test line I used:
"###########" "#o #" "# ####### #" "#### #" " #########"
Relied heavily on mobrule's Perl answer for algorithm.
My Rotation method (L) can probably be improved.
Handles wall-less case.

Code Golf: Triforce

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.
This is inspired by/taken from this thread: http://www.allegro.cc/forums/thread/603383
The Problem
Assume the user gives you a numeric input ranging from 1 to 7. Input should be taken from the console, arguments are less desirable.
When the input is 1, print the following:
***********
*********
*******
*****
***
*
Values greater than one should generate multiples of the pattern, ending with the one above, but stacked symmetrically. For example, 3 should print the following:
*********** *********** ***********
********* ********* *********
******* ******* *******
***** ***** *****
*** *** ***
* * *
*********** ***********
********* *********
******* *******
***** *****
*** ***
* *
***********
*********
*******
*****
***
*
Bonus points if you print the reverse as well.
*********** ***********
********* *********
******* *******
***** *****
*** ***
* *
***********
*********
*******
*****
***
*
*
***
*****
*******
*********
***********
* *
*** ***
***** *****
******* *******
********* *********
*********** ***********
Can we try and keep it to one answer per language, that we all improve on?
Assembler, 165 bytes assembled
Build Instructions
Download A86 from here
Add a reference to the A86 executable into your DOS search path
Paste the code below into a text file (example: triforce.asm)
Invoke the assembler: a86 triforce.asm
This will create a .COM file called triforce.com
Type triforce to run
This was developed using the standard WinXP DOS box (Start->Programs->Accessories->Command Prompt). It should work with other DOS emulators.
Assemble using A86 and requires WinXP DOS box to run the .COM file it produces. Press 'q' to exit, keys 1-7 to draw the output.
l20:mov ah,7
int 21h
cmp al,'q'
je ret
sub al,'0'
cmp al,1
jb l20
cmp al,7
ja l20
mov [l0-1],al
mov byte ptr [l7+2],6
jmp $+2
mov ah,2
mov ch,0
mov bh,3
l0:mov bl,1
l1:mov dh,0
l3:cmp dh,ch
je l2
mov dl,32
int 21h
inc dh
jmp l3
ret
l2:mov dh,bh
l6:mov cl,12
l5:mov dl,42
cmp cl,bl
ja l4
mov dl,32
cmp dh,1
je l21
l4:int 21h
dec cl
jnz l5
l21:dec dh
jnz l6
mov dl,10
int 21h
mov dl,13
int 21h
l10:inc ch
l9:add bl,2
l7:cmp ch,6
jne l1
l13:add byte ptr [l7+2],6
l11:dec bh
l12:cmp bh,0
jne l0
xor byte ptr [l0+1],10
xor byte ptr [l9+1],40
xor byte ptr [l10+1],8
xor byte ptr [l13+1],40
sub byte ptr [l7+2],12
mov dh,[l0-1]
inc dh
xor [l12+2],dh
xor byte ptr [l11+1],8
xor byte ptr [l1+1],1
inc bh
cmp byte ptr [l0+1],11
je l0
jmp l20
It uses lots of self-modifying code to do the triforce and its mirror, it even modifies the self-modifying code.
GolfScript - 43 chars
~:!6*,{:^' '
*'*'12*' '
^6%.+)*+
-12>!^
6/-*
n}
/
~:!6*,{:^' '*'*'12*' '^6%.+)*+-12>!^6/-*n}/
48 Chars for the bonus
~:!6*,.-1%+{
:^' '*'*'12
*' '^6%.+
)*+-12>
!^6/-
*n}
/
~:!6*,.-1%+{:^' '*'*'12*' '^6%.+)*+-12>!^6/-*n}/
Python - 77 Chars
n=input()
for k in range(6*n):print' '*k+('*'*12+' '*(k%6*2+1))[-12:]*(n-k/6)
n=input()
for k in range(6*n):j=1+k%6*2;print' '*k+('*'*(12-j)+' '*j)*(n-k/6)
89 Chars for the bonus
n=input();R=range(6*n)
for k in R+R[::-1]:print' '*k+('*'*11+' '*11)[k%6*2:][:12]*(n-k/6)
114 Chars Version just using string replacements
u,v=' *';s=(v*11+u)*input()
while s.strip():print s;s=u+s.replace(*((v*2+u,u*3),(v*1+u*10,v*11))[' * 'in s])[:-2]
Unk Chars all in one statement, should work w/ 2.x and 3.x. The enumerate() is to allow the single input() to work for both places you need to use it.
print ('\n'.join('\n'.join(((' '*(6*n))+' '.join(('%s%s%s'%(' '*(5-x),'*'*(2*x+1),' '*(5-x)) for m in range(i + 1)))) for x in range(5,-1,-1)) for n, i in enumerate(range(int(input())-1,-1,-1))))
Yet Another Method
def f(n): print '\n'.join(' '*6*(n-r)+(' '*(5-l)+'*'*(l*2+1)+' '*(5-l)+' ')*r for r in xrange(1, n+1) for l in xrange(6))
f(input())
Ruby - 74 Chars
(6*n=gets.to_i).times{|k|puts' '*k+('*'*(11-(j=k%6*2))+' '*(j+1))*(n-k/6)}
COBOL - 385 Chars
$ cobc -free -x triforce.cob && echo 7| ./triforce
PROGRAM-ID.P.DATA DIVISION.WORKING-STORAGE SECTION.
1 N PIC 9.
1 M PIC 99.
1 value '0100***********'.
2 I PIC 99.
2 K PIC 99.
2 V PIC X(22).
2 W PIC X(99).
PROCEDURE DIVISION.ACCEPT N
COMPUTE M=N*6
PERFORM M TIMES
DISPLAY W(1:K)NO ADVANCING
PERFORM N TIMES
DISPLAY V(I:12)NO ADVANCING
END-PERFORM
DISPLAY ''
ADD 2 TO I
IF I = 13 MOVE 1 TO I ADD -1 TO N END-IF
ADD 1 TO K
END-PERFORM.
K could be returned to outside the group level. An initial value of zero for a numeric with no VALUE clause is compiler-implementation dependent, as is an initial value of space for an alpha-numeric field (W has been cured of this, at no extra character cost). Moving K back would save two characters. -free is compiler-dependant as well, so I'm probably being over-picky.
sed, 117 chars
s/$/76543210/
s/(.).*\1//
s/./*********** /gp
:
s/\*(\**)\*/ \1 /gp
t
:c
s/\* {11}\*/ ************/
tc
s/\* / /p
t
Usage: $ echo 7 | sed -rf this.sed
First attempt; improvements could probably be made...
Ruby 1.9 - 84 characters :
v=gets.to_i
v.times{|x|6.times{|i|puts' '*6*x+(' '*i+'*'*(11-2*i)+' '*i+' ')*(v-x)}}
Perl - 72 chars
die map$"x$_.("*"x(12-($l=1+$_%6*2)).$"x$l)x($n-int$_/6).$/,0..6*($n=<>)
78 chars
map{$l=$_%6*2;print$"x$_,("*"x(11-$l).$"x$l.$")x($n-int$_/6),$/}0..6*($n=<>)-1
87 chars
$n=<>;map{$i=int$_/6;$l=$_%6*2;print$"x$_,("*"x(11-$l).$"x$l.$")x($n-$i),$/}(0..6*$n-1)
97 chars
$n=<>;map{$i=int$_/6;$l=$_%6;print$"x(6*$i),($"x$l."*"x(11-2*$l).$"x$l.$")x($n-$i),$/}(0..6*$n-1)
108 chars
$n=<>;map{$i=int$_/6;$l=$_%6;print ""." "x(6*$i),(" "x$l."*"x(11-2*$l)." "x$l." ")x($n-$i),"\n";}(0..6*$n-1)
Powershell, 78 characters
0..(6*($n=read-host)-1)|%{" "*$_+("*"*(12-($k=1+$_%6*2))+" "*$k)*(.4+$n-$_/6)}
Bonus, 92 characters
$a=0..(6*($n=read-host)-1)|%{" "*$_+("*"*(12-($k=1+$_%6*2))+" "*$k)*(.4+$n-$_/6)}
$a
$a|sort
The output is stored in an array of strings, $a, and the reverse is created by sorting the array. We could, of course, just reverse the array, but it would be more characters to type :)
Haskell - 131 138 142 143 Chars
(⊗)=replicate
z o=[concat$(6*n+m)⊗' ':(o-n)⊗((11-m-m)⊗'*'++(1+m+m)⊗' ')|n<-[0..o-1],m<-[0..5]]
main=getLine>>=mapM_ putStrLn.z.read
This one is longer (146 148 chars) at present, but an interesting, alternate line of attack:
(⊗)=replicate
a↑b|a>b=' ';_↑_='*'
z o=[map(k↑)$concat$(6*n)⊗' ':(o-n)⊗"abcdefedcba "|n<-[0..o-1],k<-"abcdef"]
main=getLine>>=mapM_ putStrLn.z.read
FORTRAN - 97 Chars
Got rid of the #define and saved 8 bytes thanks to implict loops!
$ f95 triforce.f95 -o triforce && echo 7 | ./triforce
READ*,N
DO K=0,N*6
M=2*MOD(K,6)
PRINT*,(' ',I=1,K),(('*',I=M,10),(' ',I=0,M),J=K/6+1,N)
ENDDO
END
125 bytes for the bonus
READ*,N
DO L=1,N*12
K=L+5
If(L>N*6)K=N*12-L+6
M=2*MOD(K,6)
PRINT"(99A)",(32,I=7,K),((42,I=M,10),(32,I=0,M),J=K/6,N)
ENDDO
END
FORTRAN - 108 Chars
#define R REPEAT
READ*,N
DO I=0,6*N
J=MOD(I,6)*2
PRINT*,R(' ',I)//R(R('*',11-J)//R(' ',J+1),N-I/6)
ENDDO
END
JavaScript 1.8 - SpiderMonkey - 118 chars
N=readline()
function f(n,c)n>0?(c||' ')+f(n-1,c):''
for(i=0;i<N*6;i++)print(f(i)+f(N-i/6,f(11-(z=i%6*2),'*')+f(z+1)))
w/ bonus - 151 chars
N=readline()
function f(n,c)n>0?(c||' ')+f(n-1,c):''
function l(i)print(f(i)+f(N-i/6,f(11-(z=i%6*2),'*')+f(z+1)))
for(i=0;i<N*6;i++)l(i)
for(;i--;)l(i)
Usage: js thisfile.js
JavaScript - In Browser - 154 characters
N=prompt()
function f(n,c){return n>0?(c||' ')+f(n-1,c):''}
s='<pre>'
for(i=0;i<N*6;i++)s+=f(i)+f(N-i/6,f(11-(z=i%6*2),'*')+f(z+1))+'\n'
document.write(s)
The non-obfuscated version (before optimizations by gnarf):
var N = prompt();
var S = ' ';
function fill(c, n) {
for (ret=''; n--;)
ret += c;
return ret;
}
var str = '<pre>';
for (i=0; i<N*6; i++) {
str += fill(S, i);
for (j=0; j<N-i/6; j++)
str += fill('*', 11-i%6*2) + fill(S, i%6*2+1);
str += '\n';
}
document.write(str);
Here's a different algorithm that uses replace() to go from one line to the next of each line of a triangle row:
161 characters
N=readline()
function f(n,c){return n>0?(c||' ')+f(n-1,c):''}l=0
for(i=N;i>0;){r=f(i--,f(11,'*')+' ');for(j=6;j--;){print(f(l++)+r)
r=r.replace(/\*\* /g,' ')}}
F#, 184 181 167 151 147 143 142 133 chars
let N,r=int(stdin.ReadLine()),String.replicate
for l in[0..N*6-1]do printfn"%s%s"(r l" ")(r(N-l/6)((r(11-l%6*2)"*")+(r(l%6*2+1)" ")))
Bonus, 215 212 198 166 162 158 157 148 chars
let N,r=int(stdin.ReadLine()),String.replicate
for l in[0..N*6-1]#[N*6-1..-1..0]do printfn"%s%s"(r l" ")(r(N-l/6)((r(11-l%6*2)"*")+(r(l%6*2+1)" ")))
C - 120 Chars
main(w,i,x,y){w=getchar()%8*12;for(i=0;i<w*w/2;)y=i/w,x=i++%w,putchar(x>w-2?10:x<y|w-x-1<y|(x-y)%12>=11-2*(y%6)?32:42);}
Note that this solution prints some trailing spaces (which is okay, right?). It also relies on relational operators having higher precedence than bitwise OR, saving two characters.
124 Chars
main(n,i,k){n=getchar()&7;for(k=0;k<6*n;k++,putchar(10))for(i=-k-1;++i<12*n-2*k-1;putchar(32+10*(i>=0&&(11-i%12>2*k%12))));}
C - 177 183 Chars
#define P(I,C)for(m=0;m<I;m++)putchar(C)
main(t,c,r,o,m){scanf("%d",&t);for(c=t;c>0;c--)for(r=6;r>0;r--){P((t-c)*6+6-r,32);for(o=0;o<c;o++){P(r*2-1,42);P(13-r*2,32);}puts("");}}
C - 222 243 Chars (With Bonus Points)
#define P(I,C)for(m=0;m<I;m++)putchar(C)
main(t,c,r,o,m){scanf("%d",&t);for(c=t-1;-c<2+t;c-=1+!c)for(r=c<0?1:6;c<0?r<7:r>0;r+=c<0?1:-1){P((t-abs(c+1))*6+6-r,32);for(o=0;o<abs(c+1);o++){P(r*2-1,42);P(13-r*2,32);}puts("");}}
This is my first Code Golf submission as well!
Written in C
Bonus points (492 chars):
p(char *t, int c, int s){int i=0;for(;i<s;i++)printf(" ");for(i=0;i<c;i++)printf("%s",t);printf("\n");}main(int a, char **v){int i=0;int k;int c=atoi(v[1]);for(;i<c;i++){p("*********** ",c-i,i);p(" ********* ",c-i,i);p(" ******* ",c-i,i);p(" ***** ",c-i,i);p(" *** ",c-i,i);p(" * ",c-i,i);}for(i=0;i<c;i++){k=c-i-1;p(" * ",1+i,k);p(" *** ",1+i,k);p(" ***** ",1+i,k);p(" ******* ",1+i,k);p(" ********* ",1+i,k);p("*********** ",i+1,k);}}
Without bonus points (322 chars):
p(char *t, int c, int s){int i=0;for(;i<s;i++)printf(" ");for(i=0;i<c;i++)printf("%s",t);printf("\n");}main(int a, char **v){int i=0;int k;int c=atoi(v[1]);for(;i<c;i++){p("*********** ",c-i,i);p(" ********* ",c-i,i);p(" ******* ",c-i,i);p(" ***** ",c-i,i);p(" *** ",c-i,i);p(" * ",c-i,i);}}
First time posting, too!
Lua, 121 chars
R,N,S=string.rep,io.read'*n',' 'for i=0,N-1 do for j=0,5 do X=R(S,j)print(R(S,6*i)..R(X..R('*',11-2*j)..X..S,N-i))end end
123
R,N,S=string.rep,io.read'*n',' 'for i=0,N-1 do for j=0,5 do print(R(S,6*i)..R(R(S,j)..R('*',11-2*j)..R(S,j)..S,N-i))end end
PHP, 153
<?php $i=fgets(STDIN);function r($n,$c=' '){return$n>0?$c.r($n-1,$c):'';}for($l=0;$l<$i*6;){$z=$l%6*2;echo r($l).r($i-$l++/6,r(11-$z,'*').r($z+1))."\n";}
with Bonus, 210
<?php $i=fgets(STDIN);function r($n,$c=' '){return$n>0?$c.r($n-1,$c):'';}$o=array();for($l=0;$l<$i*6;){$z=$l%6*2;$o[]=r($l).r($i-$l++/6,r(11-$z,'*').r($z+1));}print join("\n",array_merge($o,array_reverse($o)));
dc 105 chars
123 129 132 139 141
[rdPr1-d0<P]sP?sn
0sk[1lk6%2*+sj32lkd0<Plnlk6/-si
[[*]12lj-d0<P32ljd0<Pli1-dsi0<I]dsIx
10Plk1+dskln6*>K]dsKx
Mathematica, 46 characters
The answer prints sideways.
TableForm#{Table["*",{l,#},{l},{j,6},{2j-1}]}&
HyperTalk - 272 chars
function triforce n
put"******" into a
put n*6 into h
repeat with y=0 to h-1
put" " after s
put char 1 to y of s after t
repeat n-y div 6
get y mod 6*2
put char 1 to 11-it of (a&a)&&char 1 to it of s after t
end repeat
put return after t
end repeat
return t
end triforce
Indentation is neither needed nor counted (HyperCard automatically adds it).
Miscellanea:
Since there is no notion of console or way to access console arguments in HyperCard 2.2 (that I know of), a function is given instead. It can be invoked with:
on mouseUp
ask "Triforce: "
put triforce(it) into card field 1
end mouseUp
To use this, a card field would be created and set to a fixed-width font. Using HyperCard's answer command would display a dialog with the text, but it doesn't work because:
The answer dialog font (Chicago) is not fixed-width.
The answer command refuses to display long text (even triforce(2) is too long).
Common Lisp, 150 characters:
(defun f(n o)(unless(= n 0)(dotimes(x 6)(format t"~v#{~a~:*~}~-1:*~v#{~?~2:*~}~%"
o" "n"~11#: "(list(- 11(* 2 x))#\*)))(f(1- n)(+ 6 o))))
77 char alternative python solution based on gnibbler's:
n=input()
k=0
exec"print' '*k+('*'*12+' '*(k%6*2+1))[-12:]*(n-k/6);k+=1;"*6*n
Amazingly the bonus came out exactly the same also (101 chars, oh well)
n=input()
l=1
k=0
s="print' '*k+('*'*12+' '*(k%6*2+1))[-12:]*(n-k/6);k+=l;"*6*n
exec s+'l=-1;k-=1;'+s

Code Golf: Spider webs

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

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