Submissions to the WTC 2017
One-Liner Competition

Variable names used in some submissions may clash.  If an entry doesn’t not appear to work, try quitting the kernel to clear all variable definitions and evaluating again.

1 One-Liner Generator

Jesse Friedman

Attached is my humble submission to the One-Liner Competition 2017 in the category of “Innovative Plagiarism”, entitled “One-Liner Generator”.

This idea stems from the realization that instead of spending the conference attempting to wring some interesting behavior out of an input cell, I could shamelessly pilfer from the Wolfram Language’s extant library of painstakingly-curated one- (or two-, or three-) liners - and so the One-Liner Generator was born. Using the beautifully introspective WolframLanguageData curated data function, the Generator picks an example from the Neat Examples section of a random function/symbol’s documentation page and CellPrints it as an input cell. In my experience, the “generated” code is a true one-liner (satisfying the contest’s guidelines) about 20-25% of the time. The judges are encouraged to blame any particularly egregious lack of brevity on the examples’ original authors.

Suggested fun activity for the judges: guess the documentation page a particular example comes from. Extra points if you can identify the example’s author or when it was written. Double extra points if the author is among the judging panel.

Note: if the Generator code errors, chances are none of the random 10 functions it picked have a Neat Examples section. Don’t panic, and evaluate again.

Thievingly yours,

CellPrint[First/@RandomChoice[Flatten[#["DocumentationExampleInputs"][[-1,2]]&/@WolframLanguageData["RandomEntities"],1]]]

div[{vx_,vy_}] := D[vx,x]+D[vy,y]

vf = {Cos[x+y^3],Sin[y+x^3]};
StreamDensityPlot[Evaluate[{vf,div[vf]}],{x,-3,3},{y,-3,3},StreamPoints->Fine,StreamScale->Large,ColorFunction->"Rainbow",MaxRecursion->2,LightingAngle->Automatic,StreamStyle->Black]

vf = { 1,Sin[(x^3)+(y^3)]};StreamDensityPlot[Evaluate[{vf,div[vf]}],{x,-3,3},{y,-3,3},StreamPoints->Fine,StreamScale->Large,ColorFunction->"Rainbow",MaxRecursion->2,LightingAngle->Automatic,StreamStyle->Black]

vf = {Sin[Cos[3 y]+Sin[3 x]],3 Cos[Cos[3 y]+3 x]};StreamDensityPlot[Evaluate[{vf,div[vf]}],{x,-3,3},{y,-3,3},StreamScale->Large,ColorFunction->"Rainbow",MaxRecursion->2,LightingAngle->Automatic,StreamStyle->Black]

2 Autumn Wolframku

Amy Friedman

Each time you evaluate, you get a new autumnal Haiku-ish poem for the season.

StringRiffle[TakeList[RandomChoice[TextWords[WikipediaData["Autumn"]],11],{3,5,3}]]

3 Untitled

Pedro Fonseca

e=WebImageSearch["wolf","Thumbnails"];
b=a=Rasterize[Style[🐺,99]];i=ImageRestyle;
Dynamic[b=i[a,i[b,.8->RandomChoice[e]]]]

4 Super Name

Daniel Reynolds

"CONGRATS! Your new name is "<>ToString[Capitalize[RandomWord[]]]<>" the ruler of "<>ToString[Capitalize[RandomWord[]]]<>"sylvania!"

5 Untitled

Richard Gass

Grid[{{{#,"S=",Total[StringLength[#]] 4.7}&/@{RandomWord[4]}},{Import["https://imgs.xkcd.com/comics/password_strength.png"]}}]

6 Deep File Explorer

Edmund Robinson

I conduct frequent bespoke analysis from a continually widening array of topics while assessing new potential risk to the company’s business and subsidiaries. This has exposed me to many new deep file formats (e.g. SHP files) most of which can contain optional sections.  Instead of searching through reams of documentation on what a file format can contain I whipped up The Deep File Explorer so that I can navigate the levels of the actual file I need to extract data from. I also use its output to extract the data that I need.

Check[Dataset[Import[#1,#2]//.{r:_Rule..}:><|r|>],If[#2=="Rules",#0[#1,"Data"]]]&[SystemDialogInput["FileOpen"],"Rules"]

7 Toy Self Driving Car

Peter Roberge

e=ExampleData;
e@e[e[][[12]]][[4]]/.x_Graphics:>HighlightImage[x,Normal@ImageContents[ImageAdjust[x,{0,0,4.7}]][All,1]]

8 Untitled

Kyle Keane

Shows which topics are the most common connectors of WL functions.

WordCloud@Flatten[Through[WolframLanguageData[]@"RelatedSymbols"]/.e_Entity:>StringDelete[e["FunctionalityAreas"],"Symbols"]]

WordCloud@Flatten[Through[RandomSample[WolframLanguageData[],20]@"RelatedSymbols"]/.e_Entity:>StringDelete[e["FunctionalityAreas"],"Symbols"]]

9 Untitled

Abby Brown

Note: This will likely take some time to evaluate. Also, the final images (if the same ones get called from the web search) should be approximately 1920 x 1920. In the Grid, the images are smaller in size, but the details may be seen after expanding the boxes.

A combination of competitions.

i[s_]:=WebImageSearch[s,"Images",MaxItems->1][[1]];
Grid[{{a=i["Wolfram Language Wolf"],b=i["Klimt"],ImageRestyle[a,0.8->b]}}]

10 Untitled

Abby Brown

Note: This will take a while to evaluate (about 15 minutes on my little laptop). It should have two outputs, one with the ListPlot3D and one with the result of Printout3D. I believe that if one were to actually print this, it should probably include PlotTheme->”FilledSurface” but that was just too many characters.

Also,  I don’t know if the same image will be imported into other computers, but on my computer, this combination  consistently captured the Stephen Wolfram Twitter image.

11 Elementary Machine Learning

George Varnavides

Please find my one-liner entry attached.

It’s using the first 98 Elementary Cellular Automata Rule Plots to train a Markov model using SequencePredict to guess what the 99th CA rule should be using only the first element.

s=Cases[RulePlot@CellularAutomaton[#],Inset[a_,__]->a,∞]&;
Join[f=Take[s@99,1],SequencePredict[s/@Range@98][f,"NextElement"->7]]

12 A true *Melting* pot

George Varnavides

f:=a=DeleteMissing[#@"Flag"&/@RandomEntity["Country",9]]
Do[Echo[FoldList[ImageRestyle,f[[1]],Thread[.01->Rest[a]]]],{50}]

13 Untitled

Atsushi Miyazawa

My code renders the 3-dimensional shadow of a complex circle.

ParametricPlot3D[(PadRight[1-IdentityMatrix[3],{3,4}]-.5).{#2#,#2#3,-#3#4,#4#},{r,0,7},{s,-2,2}]&[Cos[r],Cosh[s],Sin[r],Sinh[s]]

(Attached notes:)

(* Renders the three-dimensional shadow of a complex circle. The original code follows: *)

ParametricPlot3D[{{-0.5,0.5,0.5,-0.5},{0.5,-0.5,0.5,-0.5},{0.5,0.5,-0.5,-0.5}}.({{Cos[r+I s],Sin[r+I s]}//Re,{Cos[r+I s],Sin[r+I s]}//Im}//ComplexExpand//Flatten),{r,0,7},{s,-2,2}]

(* What I really want to do is rendering the shadow of a complexified astroid: *)

t=r+I s;z={3Cos[t]+Cos[3t],3Sin[t]-Sin[3t]};ParametricPlot3D[(PadRight[1-IdentityMatrix[3],{3,4}]-.5).({z//Re,z//Im}//ComplexExpand//Flatten),{r,0,7},{s,-.5,.5},ViewPoint->Right]

(* but I failed to shorten them. :) *)

14 Animating the *melting* pot

George Varnavides

f:=a=DeleteMissing[#@"Flag"&/@RandomEntity["Country",9]]
Echo@ListAnimate@FoldList[ImageRestyle,f[[1]],Thread[.01->Rest@a]]~Do~9