demo"
In SparseVFC: Sparse Vector Field Consensus for Vector Field Learning

This is a demonstration of the SparseVFC algorithm. This demonstration was adapted from the script in https://github.com/jiayi-ma/VFC.

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

Import related packages.

library(SparseVFC)
library(ggplot2)
library(dplyr)
library(tibble)

Load and normalize the data.

data(church)
X <- church$X
Y <- church$Y
CorrectIndex <- church$CorrectIndex

nX <- norm_vecs(X)
nY <- norm_vecs(Y)

SparseVFC.

set.seed(1614)
VecFld <- SparseVFC(nX, nY - nX, silent = FALSE)

Make some samples for drawing the victor field.

vec <- expand.grid(x = seq(-1.2, 1.2, 0.2), y = seq(-1.2, 1.2, 0.2))
vec <- vec %>%
  rowwise() %>%
  mutate(v = list(predict(VecFld, c(x, y)))) %>%
  mutate(
    vx = v[1],
    vy = v[2]
  )

The accuracy for the algorithm.

tibble(
  correct = 1:126 %in% CorrectIndex,
  VFC = 1:126 %in% VecFld$VFCIndex
) %>% table()

(Recall: $59/(59+1) = 0.9833$; precision: $59/(59+10) = 0.8551$. Those two performance measures are the same as reported in Zhao et al., 2011 https://doi.org/10.1109/CVPR.2011.5995336, indicating a correct replication.)

Plot the output vector field. (red arrows: correct arrows in the original data; black arrows: incorrect vectors in the original data; gray arrows: learned vector field.)

library(grid)
ggplot(vec, aes(x = x, y = y)) +
  geom_segment(aes(xend = x + vx, yend = y + vy),
    arrow = arrow(length = unit(0.1, "cm")), linewidth = 0.25, alpha = 0.2
  ) +
  geom_segment(
    data = cbind(nX, nY - nX) %>% as.data.frame() %>% `colnames<-`(c("x", "y", "vx", "vy")),
    aes(xend = x + vx, yend = y + vy),
    arrow = arrow(length = unit(0.1, "cm")), linewidth = 0.25
  ) +
  geom_segment(
    data = cbind(nX, nY - nX) %>% as.data.frame() %>% `colnames<-`(c("x", "y", "vx", "vy")) %>% slice(CorrectIndex),
    aes(xend = x + vx, yend = y + vy),
    arrow = arrow(length = unit(0.1, "cm")), linewidth = 0.25, color = "red"
  )