The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.
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)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)
#> 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")), 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"
)
#> Warning: Slicing with a 1-column matrix was deprecated in dplyr 1.1.0.
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.