# demo

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

Import related packages.

library(SparseVFC)
library(ggplot2)
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#>     filter, lag
#> The following objects are masked from 'package:base':
#>
#>     intersect, setdiff, setequal, union
library(tibble)

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) #> Start mismatch removal... #> iterate: 1th, gamma: 0.900000, the energy change rate: 0.924937, sigma2=0.578028 #> iterate: 2th, gamma: 0.809524, the energy change rate: 1.234984, sigma2=0.264078 #> iterate: 3th, gamma: 0.753968, the energy change rate: 0.304775, sigma2=0.186379 #> iterate: 4th, gamma: 0.706349, the energy change rate: 0.149332, sigma2=0.147645 #> iterate: 5th, gamma: 0.674603, the energy change rate: 0.099174, sigma2=0.122940 #> iterate: 6th, gamma: 0.658730, the energy change rate: 0.078741, sigma2=0.104899 #> iterate: 7th, gamma: 0.658730, the energy change rate: 0.080516, sigma2=0.090414 #> iterate: 8th, gamma: 0.642857, the energy change rate: 0.087067, sigma2=0.075050 #> iterate: 9th, gamma: 0.634921, the energy change rate: 0.073867, sigma2=0.061626 #> iterate: 10th, gamma: 0.611111, the energy change rate: 0.095015, sigma2=0.050427 #> iterate: 11th, gamma: 0.611111, the energy change rate: 0.099653, sigma2=0.038044 #> iterate: 12th, gamma: 0.587302, the energy change rate: 0.073018, sigma2=0.028603 #> iterate: 13th, gamma: 0.555556, the energy change rate: 0.063893, sigma2=0.021995 #> iterate: 14th, gamma: 0.507937, the energy change rate: 0.114747, sigma2=0.015971 #> iterate: 15th, gamma: 0.515873, the energy change rate: 0.200772, sigma2=0.005778 #> iterate: 16th, gamma: 0.507937, the energy change rate: 0.190363, sigma2=0.001516 #> iterate: 17th, gamma: 0.492063, the energy change rate: 0.092108, sigma2=0.000699 #> iterate: 18th, gamma: 0.492063, the energy change rate: 0.032097, sigma2=0.000440 #> iterate: 19th, gamma: 0.476190, the energy change rate: 0.008552, sigma2=0.000389 #> iterate: 20th, gamma: 0.476190, the energy change rate: 0.004999, sigma2=0.000354 #> iterate: 21th, gamma: 0.476190, the energy change rate: 0.003603, sigma2=0.000328 #> iterate: 22th, gamma: 0.476190, the energy change rate: 0.001645, sigma2=0.000317 #> iterate: 23th, gamma: 0.476190, the energy change rate: 0.000560, sigma2=0.000315 #> iterate: 24th, gamma: 0.476190, the energy change rate: 0.000117, sigma2=0.000315 #> iterate: 25th, gamma: 0.476190, the energy change rate: 0.000035, sigma2=0.000315 #> iterate: 26th, gamma: 0.476190, the energy change rate: 0.000001, sigma2=0.000315 #> Removing outliers succesfully completed. 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()
#>        VFC
#> correct FALSE TRUE
#>   FALSE    56    1
#>   TRUE     10   59

(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")), size = 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")), size = 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")), size = 0.25, color = "red"
)
#> Warning: Using size aesthetic for lines was deprecated in ggplot2 3.4.0.
#> ℹ Please use linewidth instead.