hexaweb.R

library(ggforce)
library(purrr)
library(tibble)
library(gganimate)

web_strand <- function(side = 1, bend = 0.5, angle = 0, start = c(0,0)){
  pos <- cbind(x=c(0, 1, 2), y = bend*c(0, 2, 0))
  post <- pos %*% matrix(c(cos(angle), -sin(angle), sin(angle), cos(angle)), ncol=2, byrow=TRUE)
  xt <- post[,1] + start[1]
  yt <- post[,2] + start[2]
  data.frame(
    x = xt,
    y = yt,
    type = 'cubic',
    point = c('end', 'control', 'end'),
    side = side,
    bend = bend
  )
}

# beziers <- pmap_df(tibble(side=1:7,angle=seq(0,360,by=60)*pi/180),.f = web_strand, bend=0.01)
# beziers <- pmap_df(tibble(side=1:7,angle=seq(0,360,by=60)*pi/180),.f = web_strand, bend=2.5)

params <- expand.grid(side=1:7,bend=seq(0,5,by=0.05))
params$angle <- seq(0,360,by=60)[params$side]*pi/180
beziers <- pmap_df(params,.f = web_strand)
head(beziers)
ggplot() +
  geom_bezier(aes(x = x, y = y, group = side), linetype = 3,
              data = beziers, colour='white',lwd=1)+
  transition_time(bend) +
  ease_aes('linear') +
  theme_no_axes() + theme(panel.background = element_rect(fill='black'))

anim_save('spider.gif')

spider.R

library(ggforce)
library(purrr)
library(tibble)
library(gganimate)
web_strand <- function(R=1,side = 1, bend = 0.5, angle = 0, startx=0, starty=0){
  pos <- cbind(x=c(0, R/2, R)-R/2, y = bend*c(0, R, 0)-R/2)
  post <- pos %*% matrix(c(cos(angle), -sin(angle), sin(angle), cos(angle)), ncol=2, byrow=TRUE)
  xt <- post[,1] + startx
  yt <- post[,2]  + starty
  data.frame(
    x = xt,
    y = yt,
    type = 'cubic',
    point = c('end', 'control', 'end'),
    side = side,
    bend = bend
  )
}

web_spoke <- function(side = 1, bend = 0.5, angle = 0){
  N <- 2
  pos <- cbind(x=seq(0,2,length=N+2), y = bend*c(0, runif(N, 1.5,2.5), 0))
  post <- pos %*% matrix(c(cos(angle), -sin(angle), sin(angle), cos(angle)), ncol=2, byrow=TRUE)
  xt <- post[,1]
  yt <- post[,2]
  data.frame(
    x = xt,
    y = yt,
    type = 'cubic',
    point = c('end', rep('control',N), 'end'),
    side = side,
    bend = bend
  )
}

# beziers <- pmap_df(tibble(side=1:7,angle=seq(0,360,by=60)*pi/180),.f = web_strand, bend=0.01)
params <- tibble(side=1:7)
params$angle <- seq(0,360,by=60)[params$side]*pi/180
R <- 2.7
params$startx <- R*sin(params$angle)
params$starty <- R*cos(params$angle)

beziers <- pmap_df(params,.f = web_strand, bend=-0.5)
spokes <- pmap_df(tibble(side=1:7,angle=seq(0,360,by=60)*pi/180),.f = web_spoke, bend=0.01)
head(beziers)
lays <- lapply(jitter(seq(0.6, 2.5,length=6),factor = 0.5), function(R) {
  params$startx <- R*sin(params$angle)
  params$starty <- R*cos(params$angle)
  params$R <- R/1.38
  params$bend <- rnorm(6,-0.2,0.04)[params$side]
lty <- paste(sample(1:5,4,T),collapse='')
  beziers <- pmap_df(params,.f = web_strand)
  geom_bezier(aes(x = x, y = y, group = side), linetype = lty,
              data = beziers, colour='white',lwd=runif(1,0.1,0.2))
})

f <- function(id){
  theta <- seq(0,360,by=60)[-7]*pi/180
  N <- length(theta)
  R <- runif(N, 0.5, 1.5)
  data.frame(x=R*cos(theta),y=R*sin(theta),id=id)
}
d <- map_df(1:3, f)

library(rphylopic)
# spider <- rphylopic::browse_phylopic('spiders')
spider_id <- '16b94f15-3072-43ec-a6b0-39f200b16399'
spider_pic <- rphylopic::get_phylopic(spider_id)


ggplot() +
  lays +
  geom_bezier(aes(x = x, y = y, group = side), lty = paste(sample(1:5,4,T),collapse=''),
              data = spokes, colour='white',lwd=0.2)+
  geom_polygon(data=d, aes(x,y,group=id),alpha=0.2,fill='white',col='white',lty=1,lwd=0.5) +
  geom_point(data=d, aes(x,y,shape=factor(id)),col='white') +
  add_phylopic(spider_pic, alpha = 1, x = 0, y = 0, ysize = 1) +
  coord_equal() +
  theme_no_axes() + theme(panel.background = element_rect(fill='black')) +
  guides(shape='none')

web.R

library(ggforce)
library(purrr)
library(tibble)
library(gganimate)

web_strand <- function(R=1,side = 1, bend = 0.5, angle = 0, startx=0, starty=0){
  pos <- cbind(x=c(0, R/2, R)-R/2, y = bend*c(0, R, 0)-R/2)
  post <- pos %*% matrix(c(cos(angle), -sin(angle), sin(angle), cos(angle)), ncol=2, byrow=TRUE)
  xt <- post[,1] + startx
  yt <- post[,2]  + starty
  data.frame(
    x = xt,
    y = yt,
    type = 'cubic',
    point = c('end', 'control', 'end'),
    side = side,
    bend = bend
  )
}

web_spoke <- function(side = 1, bend = 0.5, angle = 0){
  pos <- cbind(x=c(0, 1, 2), y = bend*c(0, 2, 0))
  post <- pos %*% matrix(c(cos(angle), -sin(angle), sin(angle), cos(angle)), ncol=2, byrow=TRUE)
  xt <- post[,1]
  yt <- post[,2]
  data.frame(
    x = xt,
    y = yt,
    type = 'cubic',
    point = c('end', 'control', 'end'),
    side = side,
    bend = bend
  )
}

# beziers <- pmap_df(tibble(side=1:7,angle=seq(0,360,by=60)*pi/180),.f = web_strand, bend=0.01)
params <- tibble(side=1:7)
params$angle <- seq(0,360,by=60)[params$side]*pi/180

beziers <- pmap_df(params,.f = web_strand, bend=-0.5)
head(beziers)
lays <- lapply(seq(0.2, 2.5,length=4), function(R) {
  params$startx <- R*sin(params$angle)
  params$starty <- R*cos(params$angle)
  params$R <- R/1.4

  beziers <- pmap_df(params,.f = web_strand, bend=-0.5)
  geom_bezier(aes(x = x, y = y, group = side), linetype = 3,
              data = beziers, colour='white',lwd=0.5)
})

spokes <- pmap_df(tibble(side=1:7,angle=seq(0,360,by=60)*pi/180),.f = web_spoke, bend=0.01)

ggplot() +
  lays +
  geom_bezier(aes(x = x, y = y, group = side), linetype = "1234",
              data = spokes, colour='white',lwd=0.2)+
  coord_equal() +
  theme_no_axes() + theme(panel.background = element_rect(fill='black'))