language agnostic - stone - Code Golf: Árbol de decisión

rosetta stone languages (23)

En Google Code Jam 2009, Ronda 1B , hay un problema llamado Decision Tree que se presta a soluciones bastante creativas.

Publica tu solución más corta; Actualizaré la respuesta aceptada a la entrada más corta actual de forma semi-frecuente, suponiendo que no solo haya creado un nuevo idioma para resolver este problema. :-PAG

Clasificaciones actuales:

107 Perl
121 PostScript (binario)
132 Ruby
154 Arco
160 PostScript (ASCII85)
170 PostScript
192 Python
196 JavaScript
199 Common Lisp
212 LilyPond
273 Esquema
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 ++ no calificado por ahora

Common Lisp, 199 bytes

Envuelto cada 80 caracteres:

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

Espaciado y sangrado:

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

Haskell, 514 bytes (¿estoy de acuerdo?).

Basado en la solución de la sutil :

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 en 489 bytes

Código envuelto en 80 caracteres, en realidad solo hay 3 líneas.

Guarde en CA y compile con: gcc -w ac -oaoa

#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);};}}}

C ++ en 698 bytes
Compilar con ''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;}

EDITAR: Lo siento; Pensé que estaba bien para las inclusiones (p. Ej., C funciona incluso sin incluir bibliotecas básicas), aunque estoy seguro de que sería si decidiera las definiciones de esta manera. No estoy en casa ahora, y no lo estaré por un tiempo: no podré modificarlo. Solo ignora mi presentación.

Python en 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()

OCaml en 718 bytes

Soy un OCAMl n00b, así que probablemente sea mucho más de lo necesario.

Uso: 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

C - 346 bytes

Compilar con 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());}}}

F #: 759 caracteres significativos (Wow, soy malo en esto;))

Versión minimizada

Versión legible

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

PostScript: 170 (regular) / 160 (ASCII85) / 121 (binario)

Mi solución más corta (regular) de PostScript hasta ahora, siempre que cambie el nombre del archivo de entrada a "r" ( 170 caracteres , incluidas las líneas nuevas); usa un procedimiento específico de GhostScript ( =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

Uso: cp input.in r; gs -q -dNOPROMPT -dNODISPLAY -dBATCH thisfile.ps > output.out cp input.in r; gs -q -dNOPROMPT -dNODISPLAY -dBATCH thisfile.ps > output.out

Aquí hay una versión binaria de esto en 121 bytes (barras invertidas y caracteres no imprimibles escapados):

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

Si no se permiten caracteres fuera del rango imprimible ASCII, PS tiene una codificación ASCII85 incorporada de fuentes binarias. Por lo tanto, tenemos la siguiente solución de 160 bytes en todos los caracteres imprimibles ASCII:

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

m4 con eco y bc, 339 bytes

Esta solución es un completo y completo truco, y me da dolor de cabeza. Contiene, entre otras cosas, comillas dobles escapadas, comillas dobles sin guardar, pares irrefutables de comilla inversa y comillas simples (incluido un par anidado de siete comillas en profundidad), expresiones regulares no citadas, multiplicación decimal de subcontratación a bc y el uso de la CADENA de craZy para eludir la macro expansión. Pero tenía que hacerse, supongo. :pag

Esto agrega una solución de "macroización final" a los tipos anteriores de soluciones (bucles iterados, recursión con mapeo lambda, etiquetas y ramas, expresiones regulares y eval, etc.)

Creo que un buen término para esto es "código macroni": D

(envuelto cada 60 caracteres, para mayor claridad)

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

Uso: $ cp input.in A; m4 thisfile.m4 > output.out $ cp input.in A; m4 thisfile.m4 > output.out

Sin embargo, soy un m4 n00b, habiéndolo aprendido solo una hora antes de escribir esto. Entonces, probablemente haya margen de mejora.

FORTRAN - 381

Guardar como a.F95
Compilar con 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

Al usar el formato predeterminado, cada uno de los resultados comienza con 2 espacios, pero el juez de google lo permite. Gracias google juez!

VERSIÓN EXPANDIDA

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

Perl en 107 caracteres

say("Case #$_:"), $_=eval"''''".''.<>''x<>, s:[a-z]+:*(/ $&//s/?:g,s//)/s*/(/):/g, eval"/$_=<>;say$_;"x<>for 1..<>

Nuevas líneas para la legibilidad; ninguno de ellos es necesario o contado.

Utiliza funciones que se encuentran solo en las últimas versiones de Perl, por lo que se ejecuta con perl -M5.010 o posterior.

Yo solía ser un novato de Perl también, así que esto funciona casi igual que el rubí. Versión original 126 caracteres, optimizaciones por peutri.

Backlinks

Palabra alineada - Programación de potencia

R en 280 bytes

Nota: En la distribución estándar de R (desde v. 2.9.2), este programa no pasa la entrada grande y falla solo en el Caso 28 (que está anidado en 99 niveles), generando un "desbordamiento de la base de datos". Para solucionar esto, modifique la línea en src/main/gram.c que lee

#define CONTEXTSTACK_SIZE 50

y reemplace el 50 con algo así como 500. Luego vuelva a compilar. 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='' '')))))))))

Uso (requiere cambio de nombre de entrada): cp input.in A; R -q --slave -f thisfile.R >output.out cp input.in A; R -q --slave -f thisfile.R >output.out

Java en 467 bytes

Esto usa el intérprete de javascript contenido en 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);}}

Gracias Varan, Chris y pfn (indirectamente) por ayudarme a acortarlo.
Por favor vea mi otra (¡aún más corta!) Respuesta de java.

Arc, 143 154 caracteres

Muy similar al CL, pero Arc seguro tiene identificadores terminantes. Envuelto cada 40 caracteres:

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

Sangrado:

(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 - Programación de encendido

JavaScript en 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,''):'')))}

Uso: $ smjs thisfile.js <input.in

Con contribuciones de Hyperlisk.

Ruby en 132

Mejorado por leonid. Las nuevas líneas son esenciales.

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 en 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*/(/,''):''}}

Acabo de enterarme de que * "" es equivalente a .join "". También se dio cuenta de que el mapa podría usarse en algunos lugares

Ruby en 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*/(/,''):''}}

Solo soy un novato para Ruby, por lo que probablemente todavía hay mucho margen de mejora

sed en 1554 caracteres (puro) / 281 (con bc)

Sí, en serio.

Uso: sed -r -f thisfile.sed < input.in > output.out

(funciona en 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/.*@/./

Esta solución omite el cero al frente del punto decimal y no maneja los casos donde la respuesta es 1.00. Afortunadamente, el juez de GCJ acepta la ausencia de un cero y no tiene ningún caso en el que la respuesta sea 1.00.

Para incluir el cero s/.*@/0./ , cambie la última línea a s/.*@/0./ ; y para manejar una caja de 1.00, agregue la línea s/^$/1/ .

Aquí hay una solución que externaliza la multiplicación a 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

Java puro en 440 bytes

Una solución Java más corta que no usa ningún truco de evaluación. Se puede reducir a 425 eliminando System.exit (0) si se ignora la salida de stderr.

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);}}

PHP en 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).'';''));}}

Esquema (Guile 1.8)

Aquí está mi versión a 278 bytes (con mejoras de KirarinSnow para bajarla a 273), después de eliminar todas las líneas nuevas (excepto las que están en literales de cadenas, por supuesto). Solo funciona en Guile 1.8 (dado que en Scheme estándar, define es una sintaxis, no un objeto, pero Guile lo representa como un objeto de todos modos).

(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)" "))))

LilyPond: 212 caracteres

¡Locura! ¡Total ridiculez! ¡LilyPond, con su intérprete Scheme integrado, logra superar a Scheme en más de CINCUENTA BYTES! Santo acrobático volando mooses en medias !!

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

Uso: lilypond thisfile.ly <input.in >output.out 2>/dev/null

El crédito le sirve a cky para escribir la solución Scheme en la que se basa, aunque esta versión ahora es sustancialmente diferente. En serio, sin embargo, el Scheme podría jugar golf un poco más ...

Haskell, 312 personajes

Aquí hay otro enfoque para Haskell. Dejé el trabajo sucio a la lex del Prelude. El envoltorio a su alrededor es Text.ParserCombinators.ReadP . Importarlo costó 36 caracteres por sí mismo, ¡uf!

El analizador es una función Features -> SExp -> Cuteness , que me ahorra la mayoría de las declaraciones de tipo en la solución de los problemas / yairchu .

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

Solía usar la join de Control.Monad, forM_ y replicateM , pero resulta que se necesita menos espacio para redefinirlos aproximadamente que para importar.

También readParen el readParen del Preludio a favor de simplemente llamar a lex antes y después. En la versión actual, no hay necesidad de verificar el paréntesis de cierre: en una entrada válida, siempre estará allí. Por otro lado, es vital comprobar el de apertura: dado que el número solo se convierte después de haber leído toda la subexpresión, se necesitaría mucho retroceso para alinearse con el análisis correcto.

En una máquina teórica con memoria infinita y tiempo de sobra, la "("<- parte podría caerse (ganancia de 4 caracteres, 308 en total). A menos que la llamada para read simplemente aborte. En la mía, la pila simplemente se desborda bastante rápido .