Created
November 6, 2012 20:04
-
-
Save wch/4027145 to your computer and use it in GitHub Desktop.
Shiny example with rotating snakes illusion
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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) | |
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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") | |
) | |
)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Nice work!