Submissions to the WTC 2020
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 Koch curve zooming in

Nikolay Murzin

Animate[Graphics[Line@AnglePath[{0,1,-2,1}[[RealDigits[#,4][[1,-1]]+1]]&/@Most@Subdivide[4^8]],PlotRange->a],{a,1*^4,0,-1}]

2 Emojify Yourself

Matt Adereth

Dynamic[Column[{#,WordCloud[Values@First@FacialFeatures[#,"EmotionWeights"]->{"🤮","😊","😢","😐","😠","😮","😱"}]}]&@CurrentImage[]]

3 Quine Tweet

Matt Adereth

Code that tweets Wolfram code that tweets Wolfram code that tweets Wolfram code...

SendMessage["Twitter",ToExpression@InString[$Line]/.RowBox->StringJoin]

4 Prime Portraits

Matt Adereth

Everyone knows that the primes are infinite, but did you know that they are so dense that there are ones that look like you?

Column@StringPartition[ToString@NextPrime@FromDigits@Flatten[(ImageData@Binarize@ImageResize[CurrentImage[],50])/.0->8],50]

5 Untitled

Sascha Kratky

Hyperlink/@Select[FileNames["*.nb",$InstallationDirectory,∞],FindList[#,StringJoin["IN " ,ToString@$VersionNumber]]!={}&]

6 Untitled

Daniel Martin

An amusing blend of two random countries, using extreme ‘code golf’:

a=CountryData;"Name"[#~StringJoin@*StringTake~UpTo@5&]"Flag"[#[[1]]~ImageCompose~{#[[2]],.5}&]/.x_@y_:>y[#~a~x&/@a[]~RandomChoice~2]

7 Untitled

Håkan Kjellerstrand

{i=Import[#];{ImageResize[i,70],TextRecognize[i,"Word"]}}&/@FileNames[All,"."]//Column

8 Favourite character’s secret identities

Nikolay Murzin

FeatureSpacePlot[Callout[#,ImageIdentify@#]&/@Flatten[FindFaces[#,"Image"]&/@WebImageSearch["Rick&Morty characters"]]]

9 Untitled

Riccardo Gonzo

Table[ImageCompose[FindFaces[CurrentImage[],"Image"][[1]],{ImageResize[ExampleData[{"TestImage","Mandrill"}],99],.1n}],{n,1,10}]

10 Mandelzoom

Michael Sollami

w={-{3,1},{1,1}};
Dynamic[w=ScalingTransform[.97{1,1},{-1.56,0}]@w;
ImageAdjust[MandelbrotSetPlot[Complex@@@w,Frame->None]]^2]

11 How 2020 Makes Me Feel

Michael Sollami

d=Dynamic;p=40{4,3};
LocatorPane[d@p,d[1.3ResourceFunction["ComplexTransformImage"][CurrentImage[],(#.{1,I})^2+p.{1,I}&,1,2]]]

12 Peter-Panning (Hands-Free Paralax)

Michael Sollami

c={0,0};
Graphics3D[{Hue@.4,3~MengerMesh~3},ViewPoint->
Dynamic@Join[c+=Total[ImageDisplacements@CurrentImage@2,3];{-3},c/9!]]

13 LogoQRCode

Nikolay Murzin

ResourceFunction["LogoQRCode"]["www.rule30prize.org/",Rasterize@ArrayPlot[CellularAutomaton[30,RandomInteger[{0,1},50],50]]]

14 Repeat After Me

Philip Maymin

Repeat After Me. Try to get as low a difference score as possible, or at least improve as you go along!
Instructions: listen for the quote, press the red box to record, do your best, press the red box to stop recording. Lather, rinse, repeat.

ListLinePlot[Echo@AudioDistance[EmitSound@#;#,AudioCapture[]]&/@WebAudioSearch["quote","Samples",#Duration<5&],Axes->False]

15 Guess the Party

Philip Maymin

Guess the Party. Given random sentences from US political party platforms 1840-2012, can you do better than 50-50 in guessing if it was a Democratic or a Republican platform?

Table[p=(r=RandomChoice)@ResourceData["Political Party Platforms"];{ChoiceDialog[s=r@TextSentences@p[[6]],{"D","R"}],p[[2]],s},9]

16 Mind Reading

Philip Maymin

Mind Reading! I will try to predict if you will pick zero or one by learning from your patterns. I get a point each time I guess right, and lose a point each time I guess wrong.
Can you get to -10 before I beat you and get to +10?

l={g=0};b=(g+=2Boole[SequencePredict[{l},l]==#]-1;AppendTo[l,#])&;Dynamic[ButtonBar[{0:>b@0,1:>b@1}]->g]

17 Triple Concepts

Catalin Popescu

ImageIdentify[#]->#&/@Rasterize/@StringJoin/@Table[RandomSample[StringSplit[":-)(83<>=x;\\|*~@#",""],3],99]//Sort//Multicolumn

18 Untitled

Catalin Popescu

ImageAssemble[Map[Nearest[Quiet@EntityValue["FoodType","Image"],#][[1]]&,ImagePartition[LinguisticAssistant,4],{2}],"Fill"]