scratch/Growing.R

#' 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 )
delabj/genArt documentation built on March 25, 2021, 11:56 p.m.