Skip to content

Instantly share code, notes, and snippets.

@baptiste

baptiste/hexaweb.R

Last active November 10, 2023 16:40
Show Gist options
  • Save baptiste/b5ecd606afc51b0a0e77edc6e3e5b531 to your computer and use it in GitHub Desktop.
Save baptiste/b5ecd606afc51b0a0e77edc6e3e5b531 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
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')
Raw
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')
Raw
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'))
@baptiste
Copy link
Author

baptiste commented Nov 10, 2023 •
edited

spider
Screenshot 2023-11-10 at 10 21 04
Screenshot 2023-11-10 at 16 00 44

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment