Identify groove locations

  1. Load libraries for setting things up
library(nbtrd) # devtools::install_github("csafe-isu/nbtrd")
  1. grooveFinder only works on x3p files. See package x3ptools at for ways to convert different file formats into x3p standard files. The NIST Research Ballistics Toolmarks data base (NRBTD)[] provides access to scans of bullets and cartridge cases from various case studies.

We will work with two bullets from a single barrel of the Hamby 252 data set. Links to the 12 scans of bullet lands in x3p format are provided in the hamby252demo object.

These commands will read in the bullets directly from the NRBTD repository, without downloading the files into your working directory:

b1 <- read_bullet(urllist = hamby44demo$bullet1)
b2 <- read_bullet(urllist = hamby44demo$bullet2)
if (!dir.exists("README_files/data")) {
if (!file.exists("README_files/data/bullet1/HS44_Barrel1_Bullet1_Land1.x3p")) {
 # NRBTDsample_download("README_files/data")
b1 <- read_bullet("README_files/data/bullet1")
## 6 files found. Reading ...
b2 <- read_bullet("README_files/data/bullet2")
## 6 files found. Reading ...

Combine the results into a single data frame:

Change measurements to microns and flip scans along y axis:

  1. Get cross sections for each of the lands:

Visualize the cross cuts:

crosscuts <- bullets %>% tidyr::unnest(ccdata)
crosscuts %>% 
  ggplot(aes(x = x, y = value)) + 
  geom_line() +
  facet_grid(bullet~land, labeller="label_both") +

  1. Get groove locations

Visualize the grooves to see the differences in identifications between the different methods:

profilesplus <- bullets %>% tidyr::gather(type_side, location, hough_left:rollapply_right) %>%
  tidyr::separate(type_side, into=c("type", "side")) %>%
  tidyr::unnest(ccdata)  # gets rid of all the other list variables 

profilesplus %>% 
  ggplot(aes(x = x/1000, y = value)) +
  facet_grid(bullet~land) +
  geom_line() +
  geom_vline(aes(xintercept=location/1000, colour=type), size=0.75) +
  theme_bw() +
  scale_colour_brewer(palette="Dark2") +
  theme(legend.position = "bottom") +
  xlab("Relative location (in millimeters)") +
  ylab("Relative height (in microns)")