Vitaliyk
September 9, 2023, 4:43pm
1
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:
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]
7 Likes
ianf
September 9, 2023, 5:19pm
2
-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]
5 Likes
Vitaliyk
September 9, 2023, 6:39pm
3
Very nice sugar syntax shaving off. And I forgot about compactness of Array. Thank you
It is a trivial change, but anyway: If the obsolete
PixelConstrained->10
gets replaced by
PlotRangePadding->0
one character is saved.
3 Likes
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.
4 Likes
jonm
September 11, 2023, 9:54am
6
Nested If is smaller than Which in this case…
5 Likes
danielr
September 13, 2023, 11:33am
7
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.
4 Likes
There are several interesting solutions in the MSE crosspost .
2 Likes
Vitaliyk
September 18, 2023, 5:05am
9
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/.{2Red,0Blue}&@DiskMatrix//ArrayPlot]
2 Likes
