knitr::opts_chunk$set( collapse = TRUE, cache = T, comment = "#", # prompt = "", fig.width = 4, fig.height = 9 )
library(imager) library(dplyr) library(ImageAlignR) if (!"ShoeSampleData" %in% installed.packages()) { devtools::install_github("srvanderplas/ShoeData") } imlinks <- system.file(package = "ShoeSampleData", "extdata/") %>% list.files(full.names = T) %>% sort() img <- load.image(imlinks[1]) plot(img)
First, we must remove the border region. Noting that most of the border region is yellow or red, we can take the ratio of the red and green color channel values to the blue color channel value (I derived this via experimentation - there may be a better way). Once we have the bounding box of the "real" portion of the image, we can switch to grayscale, clean the image up a bit, and autocrop it.
img_bbox <- img %>% imsplit(axis = "c") %>% (function(x) is.finite((x[[1]] + x[[2]])/x[[3]])) %>% as.cimg() %>% (function(x) x == 1) img_bw <- crop.bbox(img, img_bbox) %>% grayscale() %>% map_halfimg(fun = autocrop) %>% crop.borders(nx = 5, ny = 5) %>% autocrop() %>% threshold() %>% shrink(3) %>% grow(3) %>% autocrop() %>% colorise(., Yc(.) > 3500, 1) %>% autocrop() plot(img_bw)
Next, we identify the contour points as described in Gwo & Wei (2016).
contour_points <- outer_contour(img_bw) contour_points_df <- outer_contour(img_bw, as_cimg = F) plot(img_bw) contour_points %>% highlight(col = "orange")
reliable_contour_points_df <- contour_points %>% thin_contour(img = img_bw, n_angles = 50, as_cimg = F) reliable_contour_points <- contour_points %>% thin_contour(img = img_bw, n_angles = 50, as_cimg = T)
centroid <- reliable_contour_points_df %>% select(x1, y1) %>% unique() plot(img_bw) highlight(contour_points, col = "orange") segments(contour_points_df$x, contour_points_df$y, centroid$x1, centroid$y1, col = "orange", lwd = .1)
These points are then thinned by eliminating any points whose radii from the image centroid overlap, leaving only the most distant points. (The plot below shows a more sparse set of points than those actually chosen, for visualization ease.)
reliable_contour_points <- contour_points %>% thin_contour(img = img_bw, n_angles = 100, as_cimg = T)
plot(img_bw) highlight(contour_points, col = "orange") segments(reliable_contour_points_df$x, reliable_contour_points_df$y, centroid$x1, centroid$y1, col = "darkorchid1", lwd = .2)
Once the contour of the shoe has been identified, it is possible to fit an ellipse to these points, creating a major and minor axis for the shoe.
reliable_contour_points <- contour_points %>% thin_contour(img = img_bw, n_angles = 100, as_cimg = T)
ellipse <- reliable_contour_points %>% contour_ellipse_fit() ellipse
plot(img_bw) reliable_contour_points %>% highlight(col = "darkorchid1") points(ellipse$CenterX, ellipse$CenterY, col = "orange", cex = 1.5, pch = 16) ellipse_points(ellipse, col = "orange")
Using the fitted ellipse, we can take the following steps:
angle <- ellipse$Angle if (angle > 90) { angle <- angle - 180 } else if (angle > 45) { angle <- angle - 90 } else if (angle > -45) { angle <- angle } else if (angle > -90) { angle <- angle + 90 } else { angle <- angle + 180 } img_rot <- img_bw %>% pad(250, axes = "xy", val = 1) %>% rotate_xy(angle = -angle, cx = ellipse$CenterX + 250, cy = ellipse$CenterY + 250, boundary = 1) rot_ellipse <- img_rot %>% outer_contour %>% thin_contour(img = img_rot) %>% contour_ellipse_fit() plot(img_rot) ellipse_points(rot_ellipse, col = "orange")
Alternately, we can use a convenience function which completes these steps in a single command:
img_rot <- img_bw %>% img_rotate_refit(show_plot = T)
With our new, nicely aligned ellipse, we also have a natural coordinate system, with the major axis running vertically through the centroid of the image.
plot(img_rot$img) abline(v = img_rot$ellipse$CenterX, col = "purple") abline(h = img_rot$ellipse$CenterY, col = "purple")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.