public
Last active

Shiny example with rotating snakes illusion

  • Download Gist
server.r
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
library(grid)
 
shinyServer(function(input, output) {
output$main_plot <- renderPlot({
 
# Image parameters ---------------------------------------------------------
# Number of snakes in x and y directions
nx <- 3
ny <- 3
 
# Background colors
col_bg <- c("black", "white")
 
# Foreground colors
# Use HCL colors that we'll desaturate. The problem with HSV is that the
# luminance doesn't stay constant as the saturation changes.
col_fg <- c(hcl(250,
75 * input$saturation,
65 - 20 * (input$light_diff)),
hcl(70,
85 * input$saturation,
65 + 20 * input$light_diff))
 
 
# Render the image ---------------------------------------------------------
 
# Make snakes that rotate in different directions, by changing the position
# of the black and white background bars
snake_r <- snake(col_bg, col_fg)
snake_l <- snake(rev(col_bg), col_fg)
 
grid.newpage()
 
# Draw the bottom layer of snakes
for (i in 1:nx) {
for (j in 1:ny) {
pushViewport(viewport(x = i/nx, y = j/nx, width = 1/nx, height = 1/ny))
 
if ((i + j) %% 2 == 0)
grid.draw(snake_l)
else
grid.draw(snake_r)
 
popViewport()
}
}
 
# Draw the top layer of snakes
for (i in 1:(nx-1)) {
for (j in 1:(ny-1)) {
pushViewport(viewport(x = (i+0.5)/nx, y = (j+0.5)/nx, width = 1/nx, height = 1/ny))
 
if ((i + j) %% 2 == 0)
grid.draw(snake_l)
else
grid.draw(snake_r)
 
popViewport()
}
}
 
})
 
 
})
 
 
# ---------------------------------------------------------------------------
# Return a grob for a snake circle
snake <- function(col_bg, col_fg) {
nt <- 41
nr <- 15
br <- 0.8
 
r <- embed(br^(0:nr), 2)
t <- embed(seq(0, 2*pi, length=nt), 2)
i <- as.matrix(expand.grid(1:nrow(r), 1:nrow(t)))
ci <- 1 + (i[,2]%%2 + i[,1]%%2) %% 2
 
p <- t(apply(i, 1, function(x) c(r[x[1], ], t[x[2], ])))
x <- c(p[,1]*cos(p[,3]), p[,1]*cos(p[,4]), p[,2]*cos(p[,4]), p[,2]*cos(p[,3]))
y <- c(p[,1]*sin(p[,3]), p[,1]*sin(p[,4]), p[,2]*sin(p[,4]), p[,2]*sin(p[,3]))
background <- polygonGrob(x/2, y/2, id = rep.int(1:nrow(p), 4),
gp = gpar(fill = col_bg[ci], col=NA), default.units="native")
 
p <- expand.grid(1:nrow(r), -1 * seq(0, 2*pi, length=41)[-1])
p <- cbind(p[,2], rowMeans(r)[p[,1]], (r[,2]-r[,1])[p[,1]]/2)
t <- seq(0, 2*pi, length=20)[-1]
x <- c(apply(p, 1, function(a) a[2]*cos(a[1])+a[3]*(cos(a[1])*cos(t)-0.5*sin(a[1])*sin(t))))
y <- c(apply(p, 1, function(a) a[2]*sin(a[1])+a[3]*(sin(a[1])*cos(t)+0.5*cos(a[1])*sin(t))))
 
foreground <- polygonGrob(x/2, y/2, id = rep(1:nrow(p), each=length(t)),
gp = gpar(fill = col_fg[ci], col=NA), default.units="native")
 
grobTree(background, foreground)
}
ui.r
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
shinyUI(pageWithSidebar(
headerPanel("Rotating snakes illusion"),
 
sidebarPanel(
sliderInput("saturation", "Color saturation",
min = 0, max = 1, value = 1, step = 0.1),
sliderInput("light_diff", "Difference in lightness",
min = 0, max = 1, value = 1, step = 0.1),
 
br(),
p("Illusion by ",
a("Akiyoshi KITAOKA", href="http://www.ritsumei.ac.jp/~akitaoka/index-e.html")
),
p("Based on R implementation by",
a("Kohske TAKAHASHI", href="http://www.fennel.rcast.u-tokyo.ac.jp/profilee_ktakahashi.html")
)
),
 
mainPanel(
plotOutput(outputId = "main_plot", width = "800px", height = "800px")
)
 
))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.