9
|
6154 Views
|
5 Replies
|
15 Total Likes
View groups...
Share
GROUPS:

# Visual motion illusions

Posted 2 years ago
 How come something that does not move is nevertheless perceived as moving? This post on Twitter by Jacob Yates explains illusions in motion perception and inspired me to look into it using Mathematica. The theory behind this illusion of motion, is explained by Adelson and Bergen in their article: A video is a sequence of frames (still images) changing over time and can be represented as an x - y - t space. The frames are then cross sections perpendicular to the t-axis. To detect movement in the video, we make cross sections perpendicular to the x- or y-axis. Here is simple video containing a static and a moving vertical line: AnimatedImage[ Table[Image[ Graphics[{AbsoluteThickness[25], Red, Translate[Line[{{0, -1}, {0, 1}}], {x, 0}], Blue, Line[{{0, -1}, {0, 1}}]}, PlotRange -> 1.25], ImageSize -> {200, 200}], {x, -1, 1, .1}]]  If we make a cross section perpendicular to the y-axis, we see the static (blue) line mapped as a vertical line and the moving (red) line is mapped as a slanted one. ImageGraphics[ ImageAssemble[ Table[{ImageTake[vfLstL[[frm]], {30}]}, {frm, 1, 21, 1}]], AspectRatio -> 1, Frame -> True, FrameLabel -> (Style[#, Bold, 14] & /@ {"-- x --", "frame (t)"}), ImageSize -> 350]  According to the above article, motion is perceived when there is orientation in x - y - t space . In our case , motion will only be observed when there is slant in the x - t diagram . We converted a video to an x-t diagram but we can equally convert an x-t diagram to its corresponding video. Here is a function that does this: makeVideo[xtDgm_] := Module[{w, h}, {w, h} = ImageDimensions[xtDgm]; FrameListVideo[ Map[Image[ParallelTable[PixelValue[xtDgm, {x, #}], h, {x, w}]] &, Range[h]], FrameRate -> 30]]  Movement in a video means slant in the x-t diagram. A simple case is that of moving vertical lines. Here is the x-t diagram and the video derived from it: xtDgm = Image[ Graphics[ Table[{AbsoluteThickness[8], Line[{{0, d}, {1, 1 + d}}]}, {d, -1, 1, .1}], PlotRange -> {{0, 1}, {0, 1}}], ImageResolution -> 20, ImageSize -> 100]  makeVideo[xtDgm]  For our demonstration, we want only the left- and rightmost lines to move. For that we need an x-t diagram with lines that are slanted only at both ends: xtDgm2 = Image[Graphics[ Table[{{AbsoluteThickness[9], Line[{{0, d}, {.2, .2 + d}, {.8, .2 + d}, {1, .4 + d}}]}}, {d, -.5, 1, .1}], PlotRange -> {{0, 1}, {0, 1}}], ImageResolution -> 20, ImageSize -> 100]  makeVideo[xtDgm2]  To perfect this, we need filled and partially slanted strips to fill our x-t diagram. These two functions achieve this for both right- and left moving lines: edgedStripR[y_, w_, h_, d_, col_] :=(*y is y position of center, w is 1/2 of total width, d is \ fraction of 1/2 w, h is 1/2 of total height, col is the filling color*) \ {col, Polygon[{{-w + d w, y - h}, {-w, y - h - d w}, {-w, y + h - d w}, {-w + d w, y + h}, {w - d w, y + h}, {w, y + h + d w}, {w, y - h + d w}, {w - d w, y - h}}]} edgedStripL[y_, w_, h_, d_, col_] := {col, Polygon[{{-w + d w, y - h}, {-w, y - h + d w}, {-w, y + h + d w}, {-w + d w, y + h}, {w - d w, y + h}, {w, y + h - d w}, {w, y - h - d w}, {w - d w, y - h}}]} Graphics[edgedStripR[0, 2, .2, .2, Gray], Axes -> True, PlotRange -> {{-2.2, 2.2}, .5 {-1.5, 1.5}}, ImageSize -> Medium]  From this, we construct right and left x-t diagrams... {imR, imL} = Table[ImageResize[ ImageCrop@ ImageCrop[ Image[Graphics[ MapThread[ plt[#1, 1, .15, .2, #2] &, {Range[-1.9, 2, .1], Flatten@Table[{Black, White}, 20]}]], ImageResolution -> 30], {125, 162}], {50, 50}], {plt, {edgedStripR, edgedStripL}}]; Row[{imR, imL}]  ...and convert them to the corresponding videos: {vR, vL} = makeVideo /@ {imR, imL}; {goingR, goingL} = Table[VideoFrameMap[ ImagePad[#, 10, Padding -> Lighter[Gray, .25]] &, v], {v, {vR, vL}}]; vv = VideoTimeStretch[GridVideo[{goingL, goingR}], 3]  Many variations are now possible, only limited by our imagination: {vU, vD} = (VideoFrameMap[ImageRotate, #1] &) /@ {vR, vL}; videoRLUD = VideoTimeStretch[ GridVideo[{{vU, vR, vR, vR, vD}, {vU, vD, vL, vL, vD}, {vU, vD, Missing[], vU, vD}, {vU, vD, vR, vU, vD}, {vU, vL, vL, vL, vD}}, Spacings -> 5, Background -> Lighter[Gray, 0.5]], 2.5]  Some creativity can produce even more complicated examples. Adding color is one of those: {vRc, vLc} = makeVideo /@ {imRc, imLc}; Table[VideoFrameMap[ImageResize[#, {50, 70}] &, v], {v, {vRc, vLc}}]; {goingRc, goingLc} = Table[VideoFrameMap[ImagePad[#, 10, Padding -> LightGray] &, v], {v, %}]; videoRc = VideoFrameMap[ImageCompose[#, floor, Scaled[{.5, .125}]] &, goingRc]; videoLc = VideoFrameMap[ImageCompose[#, floor, Scaled[{.5, .125}]] &, goingLc]; videoRLc = VideoTimeStretch[GridVideo[{Table[videoRc, 5], Table[videoLc, 5]}], 1.5]  More complicated objects could be filled with "edged" strips and make illusions like the Mario one mentioned above!
5 Replies
Sort By:
Posted 2 years ago
 It's an interesting spacial illusion, and I can see how this sort of thing can be used to prevent accidents such as bumping into things, with a lot of application.
Posted 2 years ago
 Sorry, Hendrik, I was not aware of your contribution. When I started with mine, I analysed the attached video (marioReversePhi.mp4) that inspired me. I also noticed the flashing colours and even tested alternative sequences other than te one used: colors = VideoMapList[ Last@DominantColors[#Image, 2, {"Color", "Coverage"}] &, v]; repeatedColors = RotateLeft[ FindRepeat[colors[[All, 1]], SameTest -> (Abs[#1[[1]] - #2[[1]]] < .05 &)], 0] But I realised that neither the flashing nor the composition of the sequence was the main driver of this illusion. I converted the Mario video to grayscale and the illusion of motion was similar: VideoFrameMap[ColorConvert[#, "Grayscale"] &, v] I think that the flashing and coloring may help but the main contribution to the illusion is the edge effect which I tried to explain above. I am working further on this while trying to answer Sander Huisman about his previous suggestion. I will be back on this very interesting visual effect! Attachments:
Posted 2 years ago
 This is somewhat related to this old post - but better explained! Thanks for sharing!
Posted 2 years ago
 -- you have earned Featured Contributor Badge Your exceptional post has been selected for our editorial column Staff Picks http://wolfr.am/StaffPicks and Your Profile is now distinguished by a Featured Contributor Badge and is displayed on the Featured Contributor Board. Thank you!
Posted 2 years ago
 Fantastic! Thanks for sharing! Perhaps this could be implemented in some Wolfram function repository function? Have you thought about this?