6
|
2290 Views
|
8 Replies
|
31 Total Likes
View groups...
Share
GROUPS:

# Code golf chromostereopsis illusion

Posted 5 months ago
 I talk about this illusion in my Linkedin series. I am trying to maximally shorten the code (code golf) for chromostereopsis illusion by Akiyoshi Kitaoka: https://twitter.com/AkiyoshiKitaoka/status/1700061353346798019 The point is to make it: (1) identical to his image, (2) make code as short as possible. My take is below. Can you post a shorter answer? Least number of characters wins. Please mention count of characters in your answer. Mine is 150. I prefer to keep randomness free of fix (like SeedRandom). By identical image I meant basic image parameters -- size of objects and image. r=RandomChoice;b=Black;s=28;f=x^2+y^2; ArrayPlot[Table[Which[f<300,r[{b,Red}],300<=f<440,b,440<=f,r[{b,Blue}]], {x,-s,s},{y,-s,s}],PixelConstrained->10] 
8 Replies
Sort By:
Posted 5 months ago
 I talk about this illusion in my Linkedin series. Amazing 66 characters solution by Adam on Mathematica Stack Exchange Code Golf I hosted: Hue[2⌊2#⌋/3,1,⌊2Random[]⌋Boole@¬.44<#<.53]&~RadialGradientImage~57 That was a play on another amazing 74 characters solution by @Greg Hurst If[#<.45(r=⌊2Random[]⌋),Red,If[r#>.54,Blue,Black]]&~RadialGradientImage~57 Yet another version I enjoyed was solution by Azerbajdzan with 80 characters: ImageApply[⌊2Random[]⌋#&,21~#~57+18~#~57/.{2Red,0Blue}&@DiskMatrix//ArrayPlot] 
Posted 5 months ago
 There are several interesting solutions in the MSE crosspost.
Posted 5 months ago
 Rearranging to remove r (combined with the tips from the other responses) can get it down to 109 characters: ArrayPlot[Array[RandomChoice@{1,If[(f=#^2+#2^2)<300,Red,If[f<400,1,Blue]]}&,{57,57},-28],PlotRangePadding->0] Edit: Swapped RandomChoice[{…}] for RandomChoice@{…} to remove 1 character.
Posted 5 months ago
 Nested If is smaller than Which in this case... If[f < 300, r[{b, Red}], If[f < 440, b, r[{b, Blue}]]]
Posted 5 months ago
 -17 characters: r=RandomChoice;b=Black;ArrayPlot[Array[(f=#^2+#2^2;Which[f<300,r@{b,Red},f<400,b,True,r@{b,Blue}])&,{57,57},-28],PixelConstrained->10] 
Posted 5 months ago
 Very nice sugar syntax shaving off. And I forgot about compactness of Array. Thank you :-)
Posted 5 months ago
 It is a trivial change, but anyway: If the obsolete PixelConstrained->10 gets replaced by PlotRangePadding->0 one character is saved.
Posted 5 months ago
 Annother (trivial) variation to Ian's elegant approach: The definition of b=Black; is not necessary - you just write Black as 1: r = RandomChoice; ArrayPlot[Array[(f = #^2 + #2^2;Which[f < 300, r@{1, Red}, f < 400, 1, True, r@{1, Blue}]) &, {57,57}, -28], PlotRangePadding -> 0] This uses 125 characters.