#' Physarum model
#' Based on the writings/code found here:
#' https://fronkonstin.com/2020/08/11/abstractions/
get_index <- function(m, i){
if(i < 1){return((m + i %% m ) %% m+1)}
else if(i >= m){return(i %% m+1)}
else{return(i)}
}
phy_sensor <- function(
mat, # Environment
df, # particles
fl, # Front left sensor angle (in degress 22.5-45)
fr, # Front Right sensor angle (in degress 22.5-45)
ra, # Agent rotation angle (degrees)
so # Sensor offset distance (pixels)
){
m <- nrow(mat)
n <- ncol(mat)
num_particles <- nrow(df)
x <- df$x
y <- df$y
h <- df$h
hnew <- vector(mode = "numeric", length = (num_particles))
for(i in 1:num_particles){
# Get the coords for the points observed
# usethis::ui_todo(glue::glue("Checking Sensor {i}"))
Fx <- get_index(m, round(x[i] + so * cos(h[i])))
Fy <- get_index(n, round(x[i] + so * sin(h[i])))
FLx <- get_index(m, round(x[i] + so * cos(h[i]+fl)))
FLy <- get_index(n, round(y[i] + so * sin(h[i]+fl)))
FRx <- get_index(m, round(x[i] + so * cos(h[i]+fr)))
FRy <- get_index(n, round(y[i] + so * sin(h[i]+fr)))
# Points to check
# usethis::ui_todo(
# glue::glue("Fx = {Fx}, Fy = {Fy},
# FLx = {FLx}, FLy = {FLy},
# FLx = {FRx}, FLy = {FRy}")
# )
#
f <- mat[Fx, Fy]
FL <- mat[FLx, FLy]
FR <- mat[FRx, FLy]
# usethis::ui_todo(
# glue::glue("i = {i}, f = {f}, FL = {FL}, FR = {FR}")
# )
if((f > FL) & (f > FR)){
hnew[i] = h[i]
}
else if((f < FL) & (F < FR)){
if(sample(0:1, 1) == 0 ){
hnew[i] = h[i] + ra
} else{
hnew[i] = h[i] - ra
}
}
else if(FL < FR){
hnew[i] = h[i] - ra
}
else if(FR < FL){
hnew[i] = h[i]+ ra
}
else{
hnew[i] = h[i]
}
}
result <- data.frame(
x = x,
y = y,
h = hnew
)
return(result)
}
#' I think this could be done outside of a loop.
phy_motor <- function(
df,
n,
m,
SS # Step size—how far agent moves per step (pixels)
){
num_particles = nrow(df)
x <- df$x
y <- df$y
h <- df$h
x_new <- vector(mode = "numeric", length = (num_particles))
y_new <- vector(mode = "numeric", length = (num_particles))
for(i in 1:num_particles){
# usethis::ui_todo(
# glue::glue(
# "Checking particle {i}
# n = {n} m = {m} "
# )
# )
x_new[i] <- get_index(n, round(x[i]+SS*cos(h[i])))
y_new[i] <- get_index(m, round(y[i]+SS*sin(h[i])))
}
result <- data.frame(
x = x_new,
y = y_new,
h = h
)
return(result)
}
phy_deposition <- function(
df,
depT, # Chemoattractant deposition per step
mat
){
num_particles = nrow(df)
x <- df$x
y <- df$y
for(i in 1:num_particles){
mat[x[i], y[i]] <- mat[x[i], y[i]] + depT
}
return(mat)
}
phy_evaporate <- function(
source,
fac
){
m <- nrow(source)
n <- ncol(source)
result <- matrix(nrow = m, ncol = n)
for(y in 1:n){
for(x in 1:m){
# usethis::ui_todo(
# glue::glue(
# "x = {x}, y = {y},
# source val = {source[x,y]}"
# )
# )
result[x,y] <- (source[x,y]) * (1 - fac)
}
}
return(result)
}
#' All together now
#'
#' @param mat The environment Matrix
#' @param df data frame of agents/particles
#' @param decayT Trail-map chemoattractant diffusion decay factor
#' @param fl Front Left Sensor Angle in Radians
#' @param fr Front Right Sensor Angle in Radians
#' @param ra Agent Rotation Angle in Radians
#' @param so Sensor offset distance in Pixels
#' @param ss Agent Step Size (how far it moves per iteration)
#' @param depT Chemoattractant deposition per step
#' @param iters number of iterations
physarum <- function(
mat,
df,
decayT,
fl,
fr,
ra,
so,
ss,
depT,
iters
){
m <- nrow(mat)
n <- ncol(mat)
for( k in 1:iters){
# usethis::ui_todo(
# glue::glue("Running Sensor for iteration # {k}")
# )
df = phy_sensor(mat, df, fl, fr, ra, so)
# usethis::ui_todo(
# glue::glue("Running motor for iteration # {k}")
# )
df = phy_motor(df, m, n, ss)
# usethis::ui_todo(
# glue::glue("Running deposition for iteration # {k}")
# )
mat = phy_deposition(df, depT, mat)
# usethis::ui_todo(
# glue::glue("Running evaporate for iteration # {k}")
# )
mat = phy_evaporate(mat, decayT)
}
return(mat)
}
library(tidyverse) # to plot and transform data
library(colourlovers) # to color drawings with nice colors
library(reshape2)
library(ragg)
library(ambient)
imageW <- 800 # image width (pixels)
imageH <- 600 # image heigth (pixels)
decayT <- 0.5 # Trail-map chemoattractant diffusion decay factor
# Agent
FL <- 43.1 * pi / 180 # FL sensor angle from forward position (degrees, 22.5 - 45)
FR <- -24.7 * pi / 180 # FR sensor angle from forward position (degrees, 22.5 - 45)
RA <- 44.5 * pi / 180 # Agent rotation angle (degrees)
SO <- 5 # Sensor offset distance (pixels)
SS <- 1 # Step size—how far agent moves per step (pixels)
depT <- 15 # Chemoattractant deposition per step
iters <- 2000 # Number if iterations
agents <- 1000 # Number of agents
envM <- matrix(0 , imageH, imageW)
# Create a magnetic disc
for (i in 1:nrow(envM)){
for (j in 1:ncol(envM)){
if(sqrt((i-imageH/2)^2+(j-imageH/2)^2)>imageH/8 &
sqrt((i-imageH/2)^2+(j-imageH/2)^2)<imageH/6) envM[i,j]=5
}
}
# Place agents in a circle
tibble(h = seq(from = 0, to = 2*pi, length.out = agents)) %>%
mutate(x = (imageH/20)*cos(h)+imageH/2 + 100,
y = (imageH/20)*sin(h)+imageH/2 - 300,
h = jitter(h+pi, amount = 0) ) -> parF
tibble(h = seq(from = 0, to = 2*pi, length.out = agents)) %>%
mutate(x = (imageH/20)*cos(h)+imageH/2 - 100,
y = (imageH/20)*sin(h)+imageH/2 + 200,
h = jitter(h+pi, amount = 0) ) -> parF2
# Make agents dance
envM <- physarum(envM, rbind(parF, parF2), decayT, FL, FR,
RA, SO, SS, depT, iters)
# Transform resulting environment matrix into data frame
df <- melt(envM)
colnames(df) <- c("x","y","v") # to name columns
# Pick a top palette from colourlovers
palette <- sample(clpalettes('top'), 1)[[1]]
colors <- palette %>% swatch %>% .[[1]]
# Do the plot
ggplot(data = df %>% filter(v>0), aes(x = x, y = y, fill = log(v))) +
geom_raster(interpolate = TRUE) +
coord_equal() +
scale_fill_gradientn(colours = colors) +
scale_y_continuous(expand = c(0,0)) +
scale_x_continuous(expand = c(0,0))+
theme_canvas("black")-> plot
plot
write_csv(df, "growth_df2.csv")
ggsave("growth02.png", device = agg_png(), height = 9, width = 12, dpi = 320 )
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.