Logo for the Vision Science feed on BlueSky

readme.md

eye.R

library(tidyverse)

# from https://github.com/matsukik/grt/blob/master/R/gaborPatch.R
gaborPatchTidy <- function(
    spatial_frequency,
    orientation_degrees = 0,
    orientation_radians = (orientation_degrees * pi)/180,
    peak_contrast = 1,
    sigma = 1/6, # same for x and y
    psi = 0,
    npoints = 500,
    trim = 0, 
    trim.col = .5, 
    range = 0.66, # negative to positive
    color_low = "black",
    color_middle = "#808080",
    color_high = "white",
    colors = c(color_low, color_middle, color_high) # color values from low to high)
){
  # initialize the grid of pixels
  data = expand_grid(
    x = seq(-range, range, length.out = npoints),
    y = seq(-range, range, length.out = npoints),
  )
  
  # value to color conversion function
  ramp = colorRamp(colors, alpha=TRUE)
  value_to_color = function(x) rgb(ramp(x)/255)
  
  data = data %>% 
    mutate(xt =  x * cos(orientation_radians) + y * sin(orientation_radians)) %>% 
    mutate(yt = -x * sin(orientation_radians) + y * cos(orientation_radians)) %>% 
    mutate(wave = peak_contrast * sin(2*pi*xt*spatial_frequency + psi)) %>% 
    mutate(gauss = exp( -.5 *( (xt/sigma)^2 + (yt/sigma)^2 ))) %>% 
    mutate(gabor = ifelse(gauss < trim, trim.col*2 - 1, wave * gauss)) %>% 
    mutate(gabor_color = value_to_color(gabor*.5 + .5))
  #return
  data %>% select(-xt, -yt, -wave, -gauss)
}


# iris
eye = gaborPatchTidy(5, -30, npoints=1000, range=0.5, psi=-pi/2, 
                      colors=hsv(c(200,200,200,200,200,200,180,200,200,200)/360, .7, seq(0,1,length.out=10)))

eye %>% 
  mutate(r = sqrt(x*x + y*y)) %>% 
  mutate(theta = atan2(y, x)) %>% 
  # pupil
  mutate(color = ifelse(r < .1, "black", gabor_color)) %>% 
  # sclera
  mutate(color = ifelse(r > .4, "white", color)) %>% 
  # lower lid
  mutate(color = ifelse(sqrt(x*x +(y-1)^2)>1.38, "black", color)) %>% 
  mutate(color = ifelse(sqrt(x*x +(y-1)^2)>1.4, "#808080", color)) %>% 
  # upper lid
  mutate(color = ifelse(sqrt(x*x +(y+2)^2)>2.3, "black", color)) %>% 
  mutate(color = ifelse(sqrt(x*x +(y+2)^2)>2.32, "#808080", color)) %>% 
  
# plot
ggplot() +
  aes(x=x,y=y, fill=color) +
  geom_raster() +
  scale_fill_identity() +
  scale_x_continuous(expand = c(0,0)) +
  scale_y_continuous(expand = c(0,0)) +
  coord_fixed(ratio=1) +
  theme_void()

# save
ragg::agg_png("~/gabor.png", width=1000, height = 1000)
last_plot()
dev.off()