WOLFRAM NOTEBOOK

Another quite tricking optical illusion have recently been posted by famous Akiyoshi Kitaoka, an “experimental psychologist who studies visual illusions as well as makes illusion artworks”:
​https://x.com/AkiyoshiKitaoka/status/1798705648001327209
The essence of this illusion, quoting the artist: “The left face appears whitish and the right one blackish, but they are made up of the same luminance.” As was explained by @nemo20000 “It is nothing to do with colour. It is entirely a luminance illusion, caused by a combination of the different ‘surround’ shade (which radically affects your perception) and the shade of the line details (which reinforce light/dark perception, relative to the background).”
I wanted somehow to “deconstruction” the wonderful illusion and the animation you see above under the original is what I came up with.The last “deconstructing” frame from it simply shows how the striking difference between dark and bright disappears when the images a brought close together:
It takes a few lines of Wolfram Language to do this. Let’s start from importing the image:
In[]:=
i=Import["https://pbs.twimg.com/media/GPZJO9haAAA14xL?format=jpg&name=large"]
Out[]=
We need to know its dimensions for further operations:
In[]:=
ImageDimensions@i
Out[]=
{1220,600}
An elementary Manipulate does the job done (note versatile ImageTake that also allows to reflect the image):
In[]:=
Manipulate[Show[ImageAssemble@{​​ImagePad[ImageTake[i,{1,-1},{1,w}],{{600-w,0},{0,0}},"Reflected"],​​ImagePad[ImageTake[i,{1,-1},{-1-(600-w),-600}],{{0,600-w},{0,0}},"Reflected"]},ImageSize->500],{{w,250},600,250,-1},SaveDefinitions->True]
Out[]=
​
w

Adopting for AnimationVideo

Note powerful construct Parallelize@AnimationVideo speeding up video generation parallelizing over multiple CPU cores:
In[]:=
v1=Parallelize@AnimationVideo[ImageAssemble@{​​ImagePad[ImageTake[i,{1,-1},{1,w}],{{600-w,0},{0,0}},"Reflected"],​​ImagePad[ImageTake[i,{1,-1},{-1-(600-w),-600}],{{0,600-w},{0,0}},"Reflected"]},​​{w,600,250,-1},RasterSize->{Automatic,720}];
In[]:=
v2=Parallelize@AnimationVideo[ImageAssemble@{​​ImagePad[ImageTake[i,{1,-1},{1,w}],{{600-w,0},{0,0}},"Reflected"],​​ImagePad[ImageTake[i,{1,-1},{-1-(600-w),-600}],{{0,600-w},{0,0}},"Reflected"]},​​{w,250,600,1},RasterSize->{Automatic,720}];
In[]:=
vi=SlideShowVideo
,
,DefaultDuration.5,RasterSize->{Automatic,720};
In[]:=
vf=SlideShowVideo
,
,DefaultDuration1,RasterSize->{Automatic,720};
In[]:=
v=VideoJoin[vi,v1,vf,v2,vi,RasterSize->{Automatic,720}]
Out[]=

Adopting for animated GiF

In[]:=
frames=ParallelTable[ImageAssemble@{​​ImagePad[ImageTake[i,{1,-1},{1,w}],{{600-w,0},{0,0}},"Reflected"],​​ImagePad[ImageTake[i,{1,-1},{-1-(600-w),-600}],{{0,600-w},{0,0}},"Reflected"]},​​{w,Join[Table[600,7],Range[600,250,-7],Table[250,7],Range[250,600,7]]}];
In[]:=
Export["bwillusion.gif",frames,ImageSize->800,"DisplayDurations"->.05]
Out[]=
bwillusion.gif

CITE THIS NOTEBOOK

Wolfram Cloud

You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.


I understand and wish to continue anyway »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.