In dmattek/ARCOS: Automatic Recognition of Collective Signalling

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

library(ARCOS, quietly = T)
library(data.table, quietly = T)
library(ggplot2, quietly = T)
library(ggthemes, quietly = T)

lPar = list()

lPar$dirCore = "."
lPar$dirFramesOut = "output-frames"
lPar$saveFrames = TRUE

# Colour palette used for plotting
myColPal = ggthemes::tableau_color_pal(palette = "Tableau 20")(20)

# Custom plotting function
myPlotBinTS <- function(objTS,
                        colorVar,
                        colorPal = c("grey80",
                                             "grey20"),
                                             legendPos = "none",
                        xlim = c(0,65), 
                        ylim = c(65,0),
                        ncol = 4,
                        plotType = c("raster", "point", "tile"),
                        pointSize = 1) {

  locFrame = attr(objTS, "colFrame")
  locPos = attr(objTS, "colPos")

  locP = ggplot(objTS,
                aes(x = get(locPos[1]),
                    y = get(locPos[2])))

  if (plotType == "point") {
    locP = locP +
      geom_point(aes(color = as.factor(get(colorVar))), size = pointSize) +
      scale_color_manual(name = "ID", values = colorPal)
  } else if (plotType == "raster") {
    locP = locP +
      geom_raster(aes(fill = as.factor(get(colorVar)))) +
      scale_fill_manual(name = "ID", values = colorPal)
  } else if (plotType == "tile") {
    locP = locP +
      geom_tile(aes(fill = as.factor(get(colorVar)))) +
      scale_fill_manual(name = "ID", values = colorPal)
  }

  locP = locP +
    facet_wrap(locFrame, ncol = ncol) +
    coord_fixed(ratio=1) +
    scale_x_continuous(limits = xlim, expand = c(0,0)) +
    scale_y_continuous(trans = "reverse", limits = ylim, expand = c(0,0)) +
    theme_void() +
    theme(text = element_text(size = 20),
          legend.position = legendPos, 
          panel.border = element_rect(colour="black", 
                                      fill = NA,
                                      linewidth = 1))

  return(locP)
}

Introduction

Generate a sequence of concentrically growing waves with random duration placed randomly in X/Y/T.

Collective events

Create an arcosTS object. The eventid column corresponds to an ID of a synthetic event. The id column is the ID of an object.

# create events
nevents = 10L
maxt = 25L
maxx = 20L
maxy = 20L
maxdur = 5L

ts = ARCOS::genSynthMultiple2D(nevents = nevents,
                               maxt = maxt,
                               maxx = maxx,
                               maxy = maxy,
                               maxdur = maxdur,
                               inSeed = 1)

knitr::kable(head(ts))

# For visualisation, expand the t column to include all frames, even empty ones.
setkey(ts, t)
ts = ts[setkey(ts[,
                  .(seq(min(t, na.rm = T),
                        max(t, na.rm = T),
                        1))],
               V1)]

# reapply attributes
ARCOS::arcosTS(dt = ts,
               colPos = c("x", "y"), 
               colIDobj = "id",
               colFrame = "t")

vEventID = unique(ts$eventid)[!is.na(unique(ts$eventid))]
names(myColPal) = vEventID

myPlotBinTS(ts, 
            colorVar = "eventid",
            colorPal = myColPal,
            plotType = "tile", 
            legendPos = "right",
            ncol = 5, 
            xlim = c(-1, maxx+1), 
            ylim = c(maxy+1, -1))

Identification of collective events

Identify and track collective events. The collid column is the result of the tracking algorithm.

Note that the events can overlap, therefore the ID of collective event (column collid) from the tracking algorithm may differ from the original event id (column eventid).

tcoll = ARCOS::trackColl(ts[complete.cases(ts)], 
                         eps = 2)

knitr::kable(head(tcoll))

# For visualisation, expand t column to include all frames, even empty ones.
setkey(tcoll, t)
tcoll = tcoll[setkey(tcoll[,
                           .(seq(min(t, na.rm = T),
                                 max(t, na.rm = T),
                                 1))],
                     V1)]

# reapply attributes
ARCOS::arcosTS(dt = tcoll,
               colPos = c("x", "y"), 
               colIDobj = "id",
               colFrame = "t", 
               colIDcoll = "collid",
               fromColl = TRUE)

vCollID = unique(tcoll$eventid)[!is.na(unique(tcoll$eventid))]
names(myColPal) = vCollID

myPlotBinTS(tcoll, 
            colorVar = "collid",
            colorPal = vCollID,
            legendPos = "right",
            plotType = "tile", 
            ncol = 5, 
            xlim = c(-1, maxx+1), 
            ylim = c(maxy+1, -1))

Save frames

Save facets as individual frames in PNG files. Can be further converted to an animation.

# Create output directory for saving PNG frames
if (lPar$saveFrames) {
  dir.create(file.path(lPar$dirCore,
                       lPar$dirFramesOut), 
             recursive = TRUE, showWarnings = F)
}

vCollID = unique(tcoll$collid)[!is.na(unique(tcoll$collid))]
names(myColPal) = vCollID

if (lPar$saveFrames) {
  for (ii in seq_len(maxt)) {
    locFrame = tcoll[t == ii]

    pOut = ggplot(locFrame,
                  aes(x = x,
                      y = y)) +
      theme_void() +
      theme(text = element_text(size = 20),
            legend.position = "none", 
            panel.border = element_rect(colour="black", 
                                        fill = NA,
                                        linewidth = 1),
            panel.background = element_rect(fill = "grey90")) +
      geom_text(x=0, y=0, 
                label=sprintf("%d", ii))

    # Generate an empty plot, if data does not exists in the frame.
    if (sum(complete.cases(locFrame)) > 0) {
      pOut = pOut +
        geom_tile(aes(fill = as.factor(get("collid")))) +
        scale_fill_manual(name = "ID", 
                          values = myColPal,
        ) +
        coord_fixed(ratio=1) +
        scale_x_continuous(limits = c(-1, maxx), expand = c(0,0)) +
        scale_y_continuous(trans = "reverse", 
                           limits = c(maxy, -1), expand = c(0,0))
    } 

    locFname = file.path(lPar$dirCore,
                         lPar$dirFramesOut,
                         sprintf("frame-%04d.png", ii))

    ggsave(filename = locFname, plot = 
             pOut, width = 3, height = 3)

  }
}

Create animation

Convert a sequence of PNG files into an animated GIF using ImageMagick's convert and/or into an MP4 movie using ffmpeg.

# Use ImageMagick to create an animated GIF
vFrames <- sort(
  list.files(
    file.path(lPar$dirCore,
              lPar$dirFramesOut), 
    "^.*\\.png$", 
    full.names = T))

system2("convert", 
        args = c(vFrames, 
                 c("-loop", "0", 
                   file.path(lPar$dirCore,
                             lPar$dirFramesOut, 
                             "frame-anim.gif"))))

# Using ffmpeg to create mp4
system2("ffmpeg", 
        args = c("-y -framerate", 5, 
                 "-i", sprintf("%s/frame-%%04d.png",
                               file.path(lPar$dirCore,
                                         lPar$dirFramesOut)),
                 "-vcodec libx264 -s 560x420 -pix_fmt yuv420p",
                 file.path(lPar$dirCore,
                           lPar$dirFramesOut, 
                           "frame-anim.mp4")))