Optical illusion 23

rillusion_23.R

library(minisvg)
lightpurple <- "#c0c0f2"
darkpurple <- "#9596ce"
x <- 5
s <- x*10
a <- x*sqrt(2)
chkrs_pat <- stag$pattern(width=2*s, height=2*s, id = 'chkrs_pattern', 
                    patternUnits = 'userSpaceOnUse',
                    stag$rect(x=0, y=0, width =s, height = s, fill=lightpurple),
                    stag$rect(x=s, y=0, width =s, height = s, fill=darkpurple),
                    stag$rect(x=0, y=s, width =s, height = s, fill=darkpurple),
                    stag$rect(x=s, y=s, width =s, height = s, fill=lightpurple)
                    )

rb <- stag$polygon(id="sqr", xs = c(a, 2*a,a, 0, a), ys=c(0, a, 2*a, a, 0))
w <- s*13; h <- s*13;
doc <- svg_doc(width = w, height = h, 
               stag$rect(x=0, y=0, width = '100%', height='100%', fill='pink'))

bw <- factor(c("black", "white"))
ffs <- list(x=c(a,0,a, 2*a)-2*a,  y=c(0,a,2*a,a)-2*a) 

vg <- stag$g(id="v", 
  lapply(1:4,function(i)
    stag$use(`xlink:href`='#sqr', fill=levels(bw)[i%%2+1], 
             svg_prop$transform$translate(ffs$x[i], ffs$y[i])))
  )

hg <- stag$g(id="h", 
  lapply(1:4,function(i)
    stag$use(`xlink:href`='#sqr', fill=levels(bw)[2-i%%2], 
            svg_prop$transform$translate(ffs$x[i], ffs$y[i])))
)

rw <- rep(0:2, 4); cl <- rep(0:3, each=3)
rf <- paste0(rep("#", 12), c("v", "h"))
xs_g <- stag$g(lapply(1:12,function(i)
    stag$use(`xlink:href`=rf[i],
             svg_prop$transform$translate(rw[i]*s,cl[i]*s)))
    )

xs_pat <- stag$pattern(width=2*s, height = 2*s, id="xs_pattern",
                       patternUnits = 'userSpaceOnUse', xs_g)

sx_pat <- stag$pattern(x=0, y=s, width = 2*s, height=2*s, id="sx_pattern",
                       patternUnits = 'userSpaceOnUse', xs_g)

doc$add('defs', chkrs_pat,xs_pat,sx_pat, rb, vg, hg)

doc$rect(x=0, y=0, width = '100%', height ='100%', fill=chkrs_pat)
doc$rect(x=s-2*a, y=s-2*a, width = 6*s, height = 6*s, fill=xs_pat)
doc$rect(x=s-2*a+6*s, y=s-2*a, width = 6*s, height = 6*s, fill=sx_pat)
doc$rect(x=s-2*a, y=s-2*a+6*s, width = 6*s, height = 6*s, fill=sx_pat)
doc$rect(x=s-2*a+6*s, y=s-2*a+6*s, width = 6*s, height = 6*s, fill=xs_pat)

doc$show()

rsvg::rsvg_png(charToRaw(as.character(doc)), "illusion_23.png")

Output