Code Golf: Decision Tree - 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.
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

Related

LISP - Fast output of byte array

I am making a compiler for a language in LISP, and the overall aim is for the compiler to produce LISP code from the original language. Trying to measure the performance of the generated code, I found that it is severely lacking in printing strings.
In the original language, characters are byte -arithmetic- values, thus strings are arrays of bytes, and the value of the byte corresponds to the character whose value is the ascii-code of the byte. A "printable" byte array must be null-terminated. Thus, to print a byte array as a character string, I have to map the original array's elements into characters before printing it. The function that handles this is as follows:
(defun writeString (X &AUX (NPOS 0) (i 0))
(declare (type (simple-VECTOR fixnum *) x))
(declare (type fixnum NPOS i))
(SETF NPOS (POSITION 0 X))
(IF (NOT NPOS)
(SETF NPOS (LENGTH X)))
(princ (MAKE-ARRAY NPOS
:INITIAL-CONTENTS (map 'vector
#'code-char
(SUBSEQ X 0 NPOS))
:ELEMENT-TYPE 'base-char)))
and it is injected into the generated code.
Running a sample code with time, I found out that the princ part results in a lot of consing during execution, which slows things down. When in the place of make-array... a static string is put, there is no slowdown and no consing, so I guess that's the part the damage is done.
While compiling, I have set flags full on speed, the byte values are declared as fixnum for now in the generated code.
Can anyone point me to a better way to print my byte array as character string while avoiding excessive consing?
I could store bytes as characters from the get-go, but that would result in the parts of the language that treat them as numbers being slower due to the need to convert.
Problems in your code
Your code:
(defun writeString (X &AUX (NPOS 0) (i 0))
(declare (type (simple-VECTOR fixnum *) x))
(declare (type fixnum NPOS i))
(SETF NPOS (POSITION 0 X))
(IF (NOT NPOS)
(SETF NPOS (LENGTH X)))
(princ (MAKE-ARRAY NPOS
:INITIAL-CONTENTS (map 'vector
#'code-char
(SUBSEQ X 0 NPOS))
:ELEMENT-TYPE 'base-char)))
There are a couple of mistakes in the code:
i is not used
the first type declaration is syntactical not valid
the declaration for NPOS is wrong. You define it as FIXNUM, but it can be NIL.
There are a bunch of programming mistakes:
there is no need to allocate any array if all you want is to output characters.
even if you want to generate an array, one can do it once
X is not a good name for a string
A simple solution:
(defun writestring (bytestring)
(loop for byte across bytestring
while (plusp byte)
do (write-char (code-char byte))))
A type declared version could be:
(defun writestring (bytestring)
(declare (vector bytestring))
(loop for byte of-type (integer 0 255) across bytestring
while (plusp byte)
do (write-char (code-char byte))))
Instead (integer 0 255) one can also use (unsigned-byte 8).
About generating vectors:
Let's also look how you try to create the array:
You create an array with make-array, using the contents from another array.
Why not tell MAP to generate the correct array?
CL-USER 46 > (map '(vector base-char) #'code-char #(102 111 111 98 97 114))
"foobar"
Now if you want to allocate arrays for some reason:
do it once
map the content into the generated array. Use map-into for that. It will stop with the shorter sequence.
Example:
CL-USER 48 > (let ((bytestring #(102 111 111 98 97 114 0 100 100 100)))
(map-into (make-array (or (position 0 bytestring)
(length bytestring))
:element-type 'base-char)
#'code-char
bytestring))
"foobar"
You could rely on write-sequence, which hopefully is optimized to write a sequence of characters or bytes. It also accepts an :end argument which is useful for delimiting the end of the written string.
I doubt you really need to use literal vectors (which are always simple-vector), but if so you maybe want to change them. You can do it at read-time:
(let ((input #.(coerce #(102 111 111 98 97 114 0 100 100 100)
'(vector (mod 256)))))
(write-sequence (map '(vector base-char)
#'code-char
input)
*standard-output*
:end (position 0 input)))
I never used something like the following, but you could also open the same file in both character and byte mode, and switch whenever necessary:
(with-open-file (out-c #P"/tmp/test"
:if-exists :supersede
:direction :output)
(with-open-file (out-8 #P"/tmp/test"
:element-type '(unsigned-byte 8)
:direction :output
:if-exists :append)
(format out-c "Hello [")
(file-position out-8 (file-position out-c))
(write-sequence #(102 111 111 98 97 114) out-8)
(file-position out-c (file-position out-8))
(format out-c "]")))
It prints "Hello [foobar]" in /tmp/test, and it seems to work with multibyte characters, but you probably need to test that more.

Any way to "visualize" a thunk/function? Or how to view a function for a general argument

I'm not totally sure how to ask this, but is there a way to show the structure of a thunk?
For example
f x = x + 2
g x = 3 x
compo x = f (g x)
ans = compo 5
-- result: (3 * 5) + 2 = 17
Is there any way I could "see" the thunk for ans? As in, I could see the process of the beta reduction for compo or like the "general" form.
I would like to see, for example:
compo n
--> (3 * n) + 2
As in, if I had a function compo x, I would like to view that it is decomposed to (3*n)+2.
For example, in Mathematica:
f[x_] := x+2;
g[x_] := 3*x;
compo[x_] := f[g[x]];
compo[n]
(%
--> (3 * n) + 2
%)
There is the ghc-vis package on hackage which show a visualization of your heap and of unevaluated thunks.
See the package on hackage or the Homepage (which contains rather impressive examples).
If you just want to see the sequence of reductions, you could try using the GHCi interactive debugger. (It's in the GHC manual somewhere.) It's not nearly as easy as your typical IDE debugger, but it more or less works...
In general (we are talking about Haskell code) I think it has no sense, the final thunk stream will be different for different input data and, on the other hand, functions are expanded partially (functions are not only simple expressions).
Anyway, you can simulate it (but ugly)
Prelude> :set -XQuasiQuotes
Prelude> :set -XTemplateHaskell
Prelude> import Language.Haskell.TH
Prelude> import Language.Haskell.TH.Quote
Prelude> runQ [| $([|\x -> 3 * x|]) . $([|\y -> y + 2|]) |]
InfixE (Just (LamE [VarP x_0] (InfixE (Just (LitE (IntegerL 3))) (VarE GHC.Num.*) (Just (VarE x_0))))) (VarE GHC.Base..) (Just (LamE [VarP y_1] (InfixE (Just (VarE y_1)) (VarE GHC.Num.+) (Just (LitE (IntegerL 2))))))

Parallel MySQL access with Scheme/Ypsilon engines

I'm trying to achieve parallell MySQL access with Scheme engines (light threads, as I've come to understand it).
My problem is, I don't know how to interact with C properly, thus can't take care of the results from the MySQL C API. This could also be a question about integrating C and Scheme.
My choice of Ypsilon is because it's fast (faster than Spark at least) and R6RS. Choosing another Scheme implementation is only relevant if it's R6RS and has speed comparable to Ypsilon.
This file bind the C API:
http://code.google.com/p/ypsilon/source/browse/trunk/sitelib/ypsilon/mysql.scm?spec=svn444&r=444
Top make it compile, I had to change all int8_t to int, unsigned-int to int, etc. There's a lot of C types I miss in my Ypsilon library, that is (it's the latest complete distribution, still).
My book about Scheme, The Scheme Programming Language by Dybvig (4:th edition) sais nothing about C integration.
The function mysql_fetch_row returns a MYSQL_ROW struct. This page present a way to handle this:
(google for) fixedpoint mysql-client-in-ypsilon.html
I cannot compile this. Have to check why.
This is used:
make-bytevector-mapping = Provides transparent access to an arbitrary memory block
In its FFI, Ypsilon has a function called define-c-struct-type:
http://www.littlewing.co.jp/ypsilon/doc-draft/libref.ypsilon.c-types.html#define-c-struct-methods
I haven't tried that yet. I'll be back with more information. If anyone has succeeded with something like this, please let me know.
Regards
Olle
My code so far:
(import (core)
(ypsilon ffi)
(ypsilon c-types)
(ypsilon mysql))
(define NULL 0)
(define host "localhost")
(define user "root")
(define passwd "bla")
(define database "bla")
(define mysql)
(define query "select bla from bla")
(begin
(set! mysql (mysql_init #f))
(mysql_real_connect mysql host user passwd database 0 #f 0)
(display (mysql_stat mysql))
(newline)
(display (string-append "mysql_query:\t" (number->string (mysql_query mysql query))))
(newline)
(let ([result (mysql_store_result mysql)])
(let rec ([n (mysql_num_fields result)] [row (mysql_fetch_row result)] [lengths (mysql_fetch_lengths result)])
(display (string-append "num_fields:\t" (number->string n)))
(newline)
(display (string-append "lengths:\t" (number->string lengths)))
(newline)
(display (string-append "row:\t\t" (number->string row)))
(newline)
(if (= row (- 0 1))
""
(let ([row (make-bytevector-mapping row (bytevector-c-int-ref (make-bytevector-mapping lengths sizeof:int)) (* 10 sizeof:int))])
(display (utf8->string row))
(newline)
(newline)
(newline)
(rec n (- lengths 1) (mysql_fetch_row result))
)))
(newline)))
This will output:
Uptime: 1203 Threads: 1 Questions: 204 Slow queries: 0 Opens: 569 Flush tables: 1 Open tables: 64 Queries per second avg: 0.169
mysql_query: 0
num_fields: 1
lengths: 8525640
row: 8541880
error in bytevector-c-int-ref: expected 2, but 1 argument given
irritants:
(#<bytevector-mapping 0x821748 4>)
backtrace:
0 (bytevector-c-int-ref (make-bytevector-mapping lengths sizeof:int))
..."/home/olle/scheme/div.scm" line 54
1 (rec n (- lengths 1) (mysql_fetch_row result))
..."/home/olle/scheme/div.scm" line 63
2 (let rec ((n (mysql_num_fields result)) (row (mysql_fetch_row result)) (lengths ...) ...) ...)
..."/home/olle/scheme/div.scm" line 37
I looked at the documentation for the for bytevector-c-int-ref the first thing that jumped out to me was that it requires two arguments (like the error says) the second being a non-negative byte offset. Does it run with that change?

Code Golf: Build Me an Arc

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.
Challenge
The shortest program by character count that accepts standard input of the form X-Y R, with the following guarantees:
R is a non-negative decimal number less than or equal to 8
X and Y are non-negative angles given in decimal as multiples of 45° (0, 45, 90, 135, etc.)
X is less than Y
Y is not 360 if X is 0
And produces on standard output an ASCII "arc" from the starting angle X to the ending angle Y of radius R, where:
The vertex of the arc is represented by o
Angles of 0 and 180 are represented by -
Angles of 45 and 225 are represented by /
Angles of 90 and 270 are represented by |
Angles of 135 and 315 are represented by \
The polygonal area enclosed by the two lines is filled with a non-whitespace character.
The program is not required to produce meaningful output if given invalid input. Solutions in any language are allowed, except of course a language written specifically for this challenge, or one that makes unfair use of an external utility. Extraneous horizontal and vertical whitespace is allowed in the output provided that the format of the output remains correct.
Happy golfing!
Numerous Examples
Input:
0-45 8
Output:
/
/x
/xx
/xxx
/xxxx
/xxxxx
/xxxxxx
/xxxxxxx
o--------
Input:
0-135 4
Output:
\xxxxxxxx
\xxxxxxx
\xxxxxx
\xxxxx
o----
Input:
180-360 2
Output:
--o--
xxxxx
xxxxx
Input:
45-90 0
Output:
o
Input:
0-315 2
Output:
xxxxx
xxxxx
xxo--
xxx\
xxxx\
Perl, 235 211 225 211 207 196 179 177 175 168 160 156 146 chars
<>=~/-\d+/;for$y(#a=-$'..$'){print+(map$_|$y?!($t=8*($y>0)+atan2(-$y,$_)/atan2 1,1)&-$&/45==8|$t>=$`/45&$t<=-$&/45?qw(- / | \\)[$t%4]:$":o,#a),$/}
Perl using say feature, 161 149 139 chars
$ echo -n '<>=~/-\d+/;for$y(#a=-$'"'"'..$'"'"'){say map$_|$y?!($t=8*($y>0)+atan2(-$y,$_)/atan2 1,1)&-$&/45==8|$t>=$`/45&$t<=-$&/45?qw(- / | \\)[$t%4]:$":o,#a}' | wc -c
139
$ perl -E '<>=~/-\d+/;for$y(#a=-$'"'"'..$'"'"'){say map$_|$y?!($t=8*($y>0)+atan2(-$y,$_)/atan2 1,1)&-$&/45==8|$t>=$`/45&$t<=-$&/45?qw(- / | \\)[$t%4]:$":o,#a}'
Perl without trailing newline, 153 143 chars
<>=~/-\d+/;for$y(#a=-$'..$'){print$/,map$_|$y?!($t=8*($y>0)+atan2(-$y,$_)/atan2 1,1)&-$&/45==8|$t>=$`/45&$t<=-$&/45?qw(- / | \\)[$t%4]:$":o,#a}
Original version commented:
$_=<>;m/(\d+)-(\d+) (\d+)/;$e=$1/45;$f=$2/45; # parse angles and radius, angles are 0-8
for$y(-$3..$3){ # loop for each row and col
for$x(-$3..$3){
$t=atan2(-$y,$x)/atan2 1,1; # angle of this point
$t+=8if($t<0); # normalize negative angles
#w=split//,"-/|\\"x2; # array of ASCII symbols for enclosing lines
$s.=!$x&&!$y?"o":$t==$e||$t==$f?$w[$t]:$t>$e&&$t<$f?"x":$";
# if it's origin -> "o", if it's enclosing line, get symbol from array
# if it's between enclosing angles "x", otherwise space
}
$s.=$/;
}
print$s;
EDIT 1: Inlined sub, relational and equality operators return 0 or 1.
EDIT 2: Added version with comments.
EDIT 3: Fixed enclosing line at 360º. Char count increased significantly.
EDIT 4: Added a shorter version, bending the rules.
EDIT 5: Smarter fix for the 360º enclosing line. Also, use a number as fill. Both things were obvious. Meh, I should sleep more :/
EDIT 6: Removed unneeded m from match operator. Removed some semicolons.
EDIT 7: Smarter regexp. Under 200 chars!
EDIT 8: Lots of small improvements:
Inner for loop -> map (1 char)
symbol array from split string -> qw (3 chars)
inlined symbol array (6 chars, together with the previous improvement 9 chars!)
Logical or -> bitwise or (1 char)
Regexp improvement (1 char)
Use arithmethic for testing negative angles, inspired by Jacob's answer (5 chars)
EDIT 9: A little reordering in the conditional operators saves 2 chars.
EDIT 10: Use barewords for characters.
EDIT 11: Moved print inside of loop, inspired by Lowjacker's answer.
EDIT 12: Added version using say.
EDIT 13: Reuse angles characters for fill character, as Gwell's answer does. Output isn't as nice as Gwell's though, that would require 5 additional chars :) Also, .. operator doen't need parentheses.
EDIT 14: Apply regex directly to <>. Assign range operator to a variable, as per Adrian's suggestion to bta's answer. Add version without the final newline. Updated say version.
EDIT 15: More inlining. map{block}#a -> map expr,#a.
Lua, 259 characters
Slightly abuses the non-whitespace character clause to produce a dazzling display and more importantly save strokes.
m=math i=io.read():gmatch("%d+")a=i()/45 b=i()/45 r=i()for y=r,-r,-1 do for x=-r,r do c=m.atan2(y,x)/m.pi*4 c=c<0 and c+8 or c k=1+m.modf(c+.5)io.write(x==0 and y==0 and'o'or c>=a and c<=b and('-/|\\-/|\\-'):sub(k,k)or c==0 and b==8 and'-'or' ')end print()end
Input: 45-360 4
\\\|||///
\\\|||//
\\\\|//
--\\|/
----o----
--//|\\--
////|\\\\
///|||\\\
///|||\\\
Able to handle odd angles
Input: 15-75 8
|/////
|//////
|//////
|//////
///////
|//////-
////---
//-
o
MATLAB, 188 chars :)
input '';[w x r]=strread(ans,'%d-%d%d');l='-/|\-/|\-';[X Y]=meshgrid(-r:r);T=atan2(-Y,X)/pi*180;T=T+(T<=0)*360;T(T>w&T<x)=-42;T(T==w)=-l(1+w/45);T(T==x)=-l(1+x/45);T(r+1,r+1)=-'o';char(-T)
Commented code:
%%# Get the string variable (enclose in quotes, e.g. '45-315 4')
input ''
%%# Extract angles and length
[w x r]=strread(ans,'%d-%d%d');
%%# Store characters
l='-/|\-/|\-';
%%# Create the grid
[X Y]=meshgrid(-r:r);
%%# Compute the angles in degrees
T=atan2(-Y,X)/pi*180;
%%# Get all the angles
T=T+(T<=0)*360;
%# Negative numbers indicate valid characters
%%# Add the characters
T(T>w&T<x)=-42;
T(T==w)=-l(1+w/45);
T(T==x)=-l(1+x/45);
%%# Add the origin
T(r+1,r+1)=-'o';
%%# Display
char(-T)
Mathematica 100 Chars
Out of competition because graphics are too perfect :)
f[x_-y_ z_]:=Graphics#Table[
{EdgeForm#Red,Disk[{0,0},r,{x °,y °}],{r,z,1,-1}]
SetAttributes[f,HoldAll]
Invoke with
f[30-70 5]
Result
alt text http://a.imageshack.us/img80/4294/angulosgolf.png
alt text http://a.imageshack.us/img59/7892/angulos2.png
Note
The
SetAttributes[f, HoldAll];
is needed because the input
f[a-b c]
is otherwise interpreted as
f[(a-b*c)]
GNU BC, 339 chars
Gnu bc because of read(), else and logical operators.
scale=A
a=read()/45
b=read()/45
c=read()
for(y=c;y>=-c;y--){for(x=-c;x<=c;x++){if(x==0)if(y<0)t=-2else t=2else if(x>0)t=a(y/x)/a(1)else if(y<0)t=a(y/x)/a(1)-4else t=a(y/x)/a(1)+4
if(y<0)t+=8
if(x||y)if(t==a||t==b||t==b-8){scale=0;u=(t%4);scale=A;if(u==0)"-";if(u==1)"/";if(u==2)"|";if(u==3)"\"}else if(t>a&&t<b)"x"else" "else"o"};"
"}
quit
MATLAB 7.8.0 (R2009a) - 168 163 162 characters
Starting from Jacob's answer and inspired by gwell's use of any non-whitespace character to fill the arc, I managed the following solution:
[w x r]=strread(input('','s'),'%d-%d%d');
l='o -/|\-/|\-';
X=meshgrid(-r:r);
T=atan2(-X',X)*180/pi;
T=T+(T<=-~w)*360;
T(T>x|T<w)=-1;
T(r+1,r+1)=-90;
disp(l(fix(3+T/45)))
And some test output:
>> arc
0-135 4
\||||////
\|||///-
\||//--
\|/---
o----
I could reduce it further to 156 characters by removing the call to disp, but this would add an extra ans = preceding the output (which might violate the output formatting rules).
Even still, I feel like there are some ways to reduce this further. ;)
Ruby, 292 276 186 chars
x,y,r=gets.scan(/\d+/).map{|z|z.to_i};s=(-r..r);s.each{|a|s.each{|b|g=Math::atan2(-a,b)/Math::PI*180/1%360;print a|b==0?'o':g==x||g==y%360?'-/|\\'[g/45%4].chr: (x..y)===g ?'*':' '};puts}
Nicer-formatted version:
x, y, r = gets.scan(/\d+/).map{|z| z.to_i}
s = (-r..r)
s.each {|a|
s.each {|b|
g = (((Math::atan2(-a,b) / Math::PI) * 180) / 1) % 360
print ((a | b) == 0) ? 'o' :
(g == x || g == (y % 360)) ? '-/|\\'[(g / 45) % 4].chr :
((x..y) === g) ? '*' : ' '
}
puts
}
I'm sure someone out there who got more sleep than I did can condense this more...
Edit 1: Switched if statements in inner loop to nested ? : operator
Edit 2: Stored range to intermediate variable (thanks Adrian), used stdin instead of CLI params (thanks for the clarification Jon), eliminated array in favor of direct output, fixed bug where an ending angle of 360 wouldn't display a line, removed some un-needed parentheses, used division for rounding instead of .round, used modulo instead of conditional add
Ruby, 168 characters
Requires Ruby 1.9 to work
s,e,r=gets.scan(/\d+/).map &:to_i;s/=45;e/=45;G=-r..r;G.map{|y|G.map{|x|a=Math.atan2(-y,x)/Math::PI*4%8;print x|y!=0?a==s||a==e%8?'-/|\\'[a%4]:a<s||a>e ?' ':8:?o};puts}
Readable version:
start, _end, radius = gets.scan(/\d+/).map &:to_i
start /= 45
_end /= 45
(-radius..radius).each {|y|
(-radius..radius).each {|x|
angle = Math.atan2(-y, x)/Math::PI * 4 % 8
print x|y != 0 ? angle==start || angle==_end%8 ? '-/|\\'[angle%4] : angle<start || angle>_end ? ' ' : 8 : ?o
}
puts
}
Perl - 388 characters
Since it wouldn't be fair to pose a challenge I couldn't solve myself, here's a solution that uses string substitution instead of trigonometric functions, and making heavy use of your friendly neighbourhood Perl's ability to treat barewords as strings. It's necessarily a little long, but perhaps interesting for the sake of uniqueness:
($x,$y,$r)=split/\D/,<>;for(0..$r-1){$t=$r-1-$_;
$a.=L x$_.D.K x$t.C.J x$t.B.I x$_."\n";
$b.=M x$t.F.N x$_.G.O x$_.H.P x$t."\n"}
$_=$a.E x$r.o.A x$r."\n".$b;$x/=45;$y/=45;$S=' ';
sub A{$v=$_[0];$x==$v||$y==$v?$_[1]:$x<$v&&$y>$v?x:$S}
sub B{$x<=$_[0]&&$y>$_[0]?x:$S}
#a=!$x||$y==8?'-':$S;
push#a,map{A$_,'\\'.qw(- / | \\)[$_%4]}1..7;
push#a,!$x?x:$S,map{B$_}1..7;
eval"y/A-P/".(join'',#a)."/";print
All newlines are optional. It's fairly straightforward:
Grab user input.
Build the top ($a) and bottom ($b) parts of the pattern.
Build the complete pattern ($_).
Define a sub A to get the fill character for an angle.
Define a sub B to get the fill character for a region.
Build an array (#a) of substitution characters using A and B.
Perform the substitution and print the results.
The generated format looks like this, for R = 4:
DKKKCJJJB
LDKKCJJBI
LLDKCJBII
LLLDCBIII
EEEEoAAAA
MMMFGHPPP
MMFNGOHPP
MFNNGOOHP
FNNNGOOOH
Where A-H denote angles and I-P denote regions.
(Admittedly, this could probably be golfed further. The operations on #a gave me incorrect output when written as one list, presumably having something to do with how map plays with $_.)
C# - 325 319 chars
using System;class P{static void Main(){var s=Console.ReadLine().Split(' ');
var d=s[0].Split('-');int l=s[1][0]-48,x,y,r,a=int.Parse(d[0]),b=int.Parse(d[1]);
for(y=l;y>=-l;y--)for(x=-l;x<=l;)Console.Write((x==0&&y==0?'o':a<=(r=((int)
(Math.Atan2(y,x)*57.3)+360)%360)&&r<b||r==b%360?
#"-/|\"[r/45%4]:' ')+(x++==l?"\n":""));}}
Newlines not significant.
Sample input/output
45-180 8
\||||||||////////
\\|||||||///////
\\\||||||//////
\\\\|||||/////
\\\\\||||////
\\\\\\|||///
\\\\\\\||//
\\\\\\\\|/
--------o
135-360 5
\
\\
\\\
\\\\
\\\\\
-----o-----
----/|\\\\\
---//||\\\\
--///|||\\\
-////||||\\
/////|||||\
Java - 304 chars
class A{public static void main(String[]a){String[]b=a[0].split("-");int e=new Integer(b[1]),r=new Integer(a[1]),g,x,y=r;for(;y>=-r;y--)for(x=-r;x<=r;)System.out.print((x==0&y==0?'o':new Integer(b[0])<=(g=((int)(Math.atan2(y,x)*57.3)+360)%360)&g<e|g==e%360?"-/|\\".charAt(g/45%4):' ')+(x++<r?"":"\n"));}}
More readable version:
class A{
public static void main(String[]a){
String[]b=a[0].split("-");
int e=new Integer(b[1]),r=new Integer(a[1]),g,x,y=r;
for(;y>=-r;y--)for(x=-r;x<=r;)System.out.print((
x==0&y==0
?'o'
:new Integer(b[0])<=(g=((int)(Math.atan2(y,x)*57.3)+360)%360)&g<e|g==e%360
?"-/|\\".charAt(g/45%4)
:' '
)+(x++<r?"":"\n"));
}
}
C (902 byte)
This doesn't use trigonometric functions (like the original perl version), so it's quite ``bloated''. Anyway, here is my first code-golf submission:
#define V(r) (4*r*r+6*r+3)
#define F for(i=0;i<r;i++)
#define C ;break;case
#define U p-=2*r+2,
#define D p+=2*r+2,
#define R *++p=
#define L *--p=
#define H *p='|';
#define E else if
#define G(a) for(j=0;j<V(r)-1;j++)if(f[j]==i+'0')f[j]=a;
#define O(i) for(i=0;i<2*r+1;i++){
main(int i,char**v){char*p,f[V(8)];
int j,m,e,s,x,y,r;p=*++v;x=atoi(p);while(*p!=45)p++;
char*h="0123";y=atoi(p+1);r=atoi(*++v);
for(p=f+2*r+1;p<f+V(r);p+=2*r+2)*p=10;
*(p-2*r-2)=0;x=x?x/45:x;y/=45;s=0;e=2*r;m=r;p=f;O(i)O(j)
if(j>e)*p=h[0];E(j>m)*p=h[1];E(j>s)*p=h[2];else*p=h[3];p++;}
if(i+1==r){h="7654";m--;e--;}E(i==r){s--;}E(i>r){s--;e++;}
else{s++;e--;}p++;}for(p=f+V(r)/2-1,i=0;i<r;i++)*++p=48;
for(i=0;i<8;i++)if(i>=x&&i<y){G(64);}else G(32);
y=y==8?0:y;q:p=f+V(r)/2-1;*p='o';switch(x){
C 0:F R 45 C 1:F U R 47 C 2:F U H C 3:F U L 92
C 4:F L 45 C 5:F D L 47 C 6:F D H C 7:F D R 92;}
if(y!=8){x=y;y=8;goto q;}puts(f);}
also, the #defines look rather ugly, but they save about 200 bytes so I kept them in, anyway. It is valid ANSI C89/C90 and compiles with very few warnings (two about atoi and puts and two about crippled form of main).

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.