Checkerboard Bulge Illusion

square[clr_,num_,xcoor_,ycoor_]:={
Table[Translate[{ 
{clr,Rectangle[{1.15,5.85},{1.35,5.65}]},
{clr,Rectangle[{1.65,5.35},{1.85,5.15}]}
},{x-num,-x}],{x,xcoor,ycoor}]
}

circle[clrs_,nums_,xcoors_,ycoors_]:={
Table[Translate[{
{clrs, Disk[{1.25,5.75},0.15]},
{clrs, Disk[{1.75,5.25},0.15]}
},{x-nums,-x}],{x, xcoors, ycoors}]
}

Manipulate[
If[shape==1,Graphics[{
{Table[Translate[{Table[{Black,Rectangle[{x,1},{x+1,0}]},{x,-6,6,2}]},{0,y}],{y,-6,6,2}]},
{Table[Translate[{Table[{Black,Rectangle[{x,1},{x+1,0}]},{x,-6,4,2}]},{1,y}],{y,-5,5,2}]},
{Table[Translate[{Table[{background,Rectangle[{x,1},{x+1,0}]},{x,-6,4,2}]},{1,y}],{y,-6,6,2}]},{Table[Translate[{Table[{background,Rectangle[{x,1},{x+1,0}]},{x,-6,6,2}]},{0,y}],{y,-5,5,2}]},
{Opacity[1-opacity],{{square[color,0,0,4]},
{square[Black,-1,1,2]},
{square[Black,1,1,4]},
{square[color,2,2,4]},
{square[Black,3,3,4]},
{square[color,4,4,4]},
{Rotate[{{square[color,0,0,4]},
{square[Black,-1,1,2]},
{square[Black,1,1,4]},
{square[color,2,2,4]},
{square[Black,3,3,4]},
{square[color,4,4,4]}},180Degree,{0.5,0.5}]},
{Rotate[{{square[color,0,0,4]},
{square[Black,-1,1,2]},
{square[Black,1,1,4]},
{square[color,2,2,4]},
{square[Black,3,3,4]},
{square[color,4,4,4]}},90Degree,{0.5,0.5}]},
{Rotate[{{square[color,0,0,4]},
{square[Black,-1,1,2]},
{square[Black,1,1,4]},
{square[color,2,2,4]},
{square[Black,3,3,4]},
{square[color,4,4,4]}},270Degree,{0.5,0.5}]},
{Table[Translate[{{Black,Rectangle[{0.85,5.15},{0.65,5.35}]},
{Black,Rectangle[{0.15,5.15},{0.35,5.35}]}},{0,y-6}],{y,1,6}]},
{Table[Translate[{{color,Rectangle[{0.85,4.15},{0.65,4.35}]},
{color,Rectangle[{0.15,4.15},{0.35,4.35}]}},{0,y-5}],{y,3,5,2}]},
{Rotate[{{Table[Translate[{{Black,Rectangle[{0.85,5.15},{0.65,5.35}]},
{Black,Rectangle[{0.15,5.15},{0.35,5.35}]}},{0,y-6}],{y,1,6}]},
{Table[Translate[{{color,Rectangle[{0.85,4.15},{0.65,4.35}]},
{color,Rectangle[{0.15,4.15},{0.35,4.35}]}},{0,y-5}],{y,3,5,2}]}},180Degree,{0.5,0.5}]},
{Rotate[{{Table[Translate[{{Black,Rectangle[{0.85,5.15},{0.65,5.35}]},
{Black,Rectangle[{0.15,5.15},{0.35,5.35}]}},{0,y-6}],{y,1,6}]},
{Table[Translate[{{color,Rectangle[{0.85,4.15},{0.65,4.35}]},
{color,Rectangle[{0.15,4.15},{0.35,4.35}]}},{0,y-5}],{y,3,5,2}]}},90Degree,{0.5,0.5}]},
{Rotate[{{Table[Translate[{{Black,Rectangle[{0.85,5.15},{0.65,5.35}]},
{Black,Rectangle[{0.15,5.15},{0.35,5.35}]}},{0,y-6}],{y,1,6}]},
{Table[Translate[{{color,Rectangle[{0.85,4.15},{0.65,4.35}]},
{color,Rectangle[{0.15,4.15},{0.35,4.35}]}},{0,y-5}],{y,3,5,2}]}},270Degree,{0.5,0.5}]}},{}
}
},Axes->False,ImageSize->{475,400}],
Graphics[{
{Table[Translate[{Table[{Black,Rectangle[{x,1},{x+1,0}]},{x,-6,6,2}]},{0,y}],{y,-6,6,2}]},
{Table[Translate[{Table[{Black,Rectangle[{x,1},{x+1,0}]},{x,-6,4,2}]},{1,y}],{y,-5,5,2}]},{Table[Translate[{Table[{background,Rectangle[{x,1},{x+1,0}]},{x,-6,4,2}]},{1,y}],{y,-6,6,2}]},{Table[Translate[{Table[{background,Rectangle[{x,1},{x+1,0}]},{x,-6,6,2}]},{0,y}],{y,-5,5,2}]},
{Opacity[1-opacity],{{circle[color,0,0,4]},
{circle[Black, 1, 1, 4]},
{circle[color,2,2,4]},
{circle[Black,3,3,4]},
{circle[color,4,4,4]},
{circle[Black,-1,1,2]},
{Rotate[{{circle[color,0,0,4]},
{circle[Black, 1, 1, 4]},
{circle[color,2,2,4]},
{circle[Black,3,3,4]},
{circle[color,4,4,4]},
{circle[Black,-1,1,2]}},180Degree,{0.5,0.5}]},
{Rotate[{{circle[color,0,0,4]},
{circle[Black, 1, 1, 4]},
{circle[color,2,2,4]},
{circle[Black,3,3,4]},
{circle[color,4,4,4]},
{circle[Black,-1,1,2]}},90Degree,{0.5,0.5}]},
{Rotate[{{circle[color,0,0,4]},
{circle[Black, 1, 1, 4]},
{circle[color,2,2,4]},
{circle[Black,3,3,4]},
{circle[color,4,4,4]},
{circle[Black,-1,1,2]}},270Degree,{0.5,0.5}]},
{Table[Translate[{{color, Disk[{0.25,5.25},0.15]},{color,Disk[{0.75,5.25},0.15]}},{0,y-6}],{y,2,6}]},
{Table[Translate[{{Black, Disk[{0.25,5.25},0.15]},{Black,Disk[{0.75,5.25},0.15]}},{0,y-5}],{y,1,5,2}]},
{Rotate[{{Table[Translate[{{color, Disk[{0.25,5.25},0.15]},{color,Disk[{0.75,5.25},0.15]}},{0,y-6}],{y,2,6}]},
{Table[Translate[{{Black, Disk[{0.25,5.25},0.15]},{Black,Disk[{0.75,5.25},0.15]}},{0,y-5}],{y,1,5,2}]}},180Degree,{0.5,0.5}]},
{Rotate[{{Table[Translate[{{color, Disk[{0.25,5.25},0.15]},{color,Disk[{0.75,5.25},0.15]}},{0,y-6}],{y,2,6}]},
{Table[Translate[{{Black, Disk[{0.25,5.25},0.15]},{Black,Disk[{0.75,5.25},0.15]}},{0,y-5}],{y,1,5,2}]}},90Degree,{0.5,0.5}]},
{Rotate[{{Table[Translate[{{color, Disk[{0.25,5.25},0.15]},{color,Disk[{0.75,5.25},0.15]}},{0,y-6}],{y,2,6}]},
{Table[Translate[{{Black, Disk[{0.25,5.25},0.15]},{Black,Disk[{0.75,5.25},0.15]}},{0,y-5}],{y,1,5,2}]}},270Degree,{0.5,0.5}]}},{}
}
},Axes->False,ImageSize->{475,400}]],
Row[{Control@{opacity,0,1,Appearance->"Labeled"},
Spacer[20],
Control@{{shape,1,"small shape"},{1->"squares",2->"circles"},SetterBar}}],
Row[{
Control@{{background,White,"large color"},ColorSlider},
Spacer[10],
Control@{{color,White,"small color"},ColorSlider}}], SaveDefinitions->True]

CAPTION

This illusion gives the appearance of the checkerboard bulging in the center when some smaller squares or circles are inserted in the squares near the center. However, when the smaller shapes disappear, you can see that the checkerboard is in fact undistorted. This Demonstration includes controls that change the appearance of the board in order to show how slight alterations affect the illusion.

DETAILS

This was a project for Advanced Topics in Mathematics II, 2016–2017, Torrey Pines High School, San Diego, CA.

THIS NOTEBOOK IS THE SOURCE CODE FROM

Priyanka Multani

"Checkerboard Bulge Illusion"
 http://demonstrations.wolfram.com/CheckerboardBulgeIllusion/
 Wolfram Demonstrations Project
 Published: March 1, 2017

A full-function Wolfram Mathematica system is required to edit this notebook.
GET WOLFRAM MATHEMATICA »

© Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »