Mathematica 
One-Liner Competition 2011 Awards

(Advance to next slide using the right-arrow key.)

Submissions

33 one-liners submitted

18 submitters

Judges

Arnoud Buzing, Director of Quality and Release Management
Brett Champion, Kernel Developer
Chris Cole, Quality Assurance Engineer
Peter Fleck, Manager, Wolfram Technology Group
Oyvind Tafjord, Chief Architect, Wolfram Alpha

Honorable Mention

Honorable Mention

William Wu

Anagram Bands (136 characters)

An interesting submission, but the judges had to edit the submission by adding “w =” to make it work, disqualifying it from consideration.

w=RandomSample[WordData[All,#]]&/@{"Adjective","Noun"};Do[If[a≠n&&Equal@@(Sort@Characters@#&/@{a,n}),Print[a<>" "<>n]],{a,w[[1]]},{n,w[[2]]}]

Honorable Mention

Honorable Mention

Sascha Kratky

Desktop Search Engine (140 + 32 characters)

Another admirable submission, but since it did not produce output without a subsequent invocation of 32 characters—which put it over the 140-character limit—this entry was sadly disqualified.

DS[d_,f_]:=Manipulate[
Pick[x[[1]],Or@@StringMatchQ[#,ToString[s]]&/@x[[2]]],
{s},
Initialization:>{x=FileNames[f,d,∞]//{#,ReadList[#,Word]&/@#}&}
]

DS[$InstallationDirectory,"*.m"]

Honorable Mention

Honorable Mention

Chuck Ronco

The music of π (128 characters)

Sound[SoundNote@@@Table[{{RealDigits[N[Pi,51]][[1,i]]},.46,"NewAge"},{i,51}]/.ArrayRules[ToString/@{C,D,E,F5,G,A1,B3,C5,D5,C3}]]

Honorable Mention

Honorable Mention

Stephan Leibbrandt

Fractal (130 characters)

Image@Compile[{},Block[{i,x,p},Table[i=0;x=0.I;p=r+I c;While[Abs@x≤(Sqrt[2])&&i<(9^3),x=(x^2)+p;++i];Tanh[((i/(9^3))^(1/7))],{c,-1,1,.01},{r,-2,1,.01}]]][]

Honorable Mention

Honorable Mention

Dave Lawrence

World’s Smallest Mathematica Quine (0 characters)

See below. Don’t miss it.

Dishonorable Mention

Dishonorable Mention

Zdenek Buk

WS Data (125 characters)

Very clever, but the judges didn’t buy it.

SelectionMove[n=InputNotebook[],All,EvaluationCell];Image[Partition[Characters[NotebookRead[n][[1,1,1,-1]]]/.{" "->0,"\t"->1},57]]

Third Place

Third Place

William Wu

Life’s Work, Easily Replaced (137 characters)

ToExpression@Uncompress@"1:eJxTTMoPCrZjYGDQCEgsLU51MLJWtrFTUtBVSEnNSS1JTdFT0tfXqA4oyswrcVDWCS5ITcx2UK5V09RU03dwy8xJ9UvMTS2OjgUAuVYUpg==";

Second Place

Second Place

Yves Klett

Instant Recursive Art (101 characters)

Colorize@WatershedComponents[Erosion[ImportString[ExportString[EvaluationNotebook[],"JPG"],"JPG"],1]]

First-And-A-Half Place

One set of three excellent entries was submitted before the competition deadline, but did not arrive in the competition inbox until well after the deadline had passed.  The judges considered those entries after the competition had completed and retroactively awarded them halfway between first and second place—first-and-a-half place.

First-And-A-Half Place

Stephan Leibbrandt

Shooter (140 characters)

Click to shoot before a disk falls through.

X=Y=x=y=0
ClickPane[Dynamic@Graphics[{Point[{x,++y}],Disk@If[#.#>1&[{x,y}-{X,Y}],{X,Y-=.1},{X,Y}={RandomReal[9],9}]},PlotRange->9],({x,y}=#)&]

First-And-A-Half Place

Stephan Leibbrandt

Slow Motion (130 characters)

(p=Table[#[],{9}];
Dynamic[Fold[ImageDifference,#[[1]],Rest@#]&[ImageSubtract@@@Partition[p=Join[Rest@p,{#[]}],2,1]]])&[CurrentImage]

First Place

First Place

Zdenek Buk

Recursive Image Collage (140 characters)

ImageAssemble[Round[Rescale[ImageData[i=Nest[Darker,ImageResize[ExampleData[{"TestImage","Elaine"}],50],3]]]9]/.n_Integer:>Nest[Lighter,i,n]]

First Place

Zdenek Buk

Animated Sky Chart (137 characters)

g={#,WolframAlpha["sky chart "<>#,{{"SkyMap:AstronomicalData",1},"Content"}]}&/@(DateString[DatePlus[Date[],#]]&/@Range[10]);
ListAnimate[g]

Setup

SetOptions[InputNotebook[],WindowSize->{1023,767}]

SetOptions[InputNotebook[],CellHorizontalScrolling->False]

SetOptions[InputNotebook[],NotebookEventActions->{"LeftArrowKeyDown":>Do[FrontEndExecute[FrontEnd`FrontEndToken[FrontEnd`InputNotebook[],"ScrollPagePrevious"]],{If[CurrentValue["ShiftKey"],10,1]}],"RightArrowKeyDown":>Do[FrontEndExecute[FrontEnd`FrontEndToken[FrontEnd`InputNotebook[],"ScrollPageNext"]],{If[CurrentValue["ShiftKey"],10,1]}]}];