Movatterモバイル変換


[0]ホーム

URL:


bulletcp

The goal of ‘bulletcp’ is to easily automate the identification ofgroove locations via a Bayesian changepoint model on data which are 2Dcrossections of 3D bullet land scans. Ultimately, this package willpotentially support other packages implementing automated bullet landmatching algorithms for use by forensic scientists or statisticians. Theonly function that should ideally be used by a user or another functionisget_grooves_bcp(), which takes minimal arguments (thoughseveral optional arguments can be supplied) and returns a list. Of theitems in the list, the only one that should ideally be needed by anyoneis the one called “groove”: a two element vector of estimated groovelocations.

Installation

You can install the released version of ‘bulletcp’ fromCRAN with:

install.packages("bulletcp")

Example

The ideal usage of the package is now demonstrated on the exampledata included. First, we show what the data should look like.

library(bulletcp)#> Loading required package: mvtnorm#> Loading required package: 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#> Loading required package: assertthatlibrary(ggplot2)data("example_data")head(raw_data)#>       x value#> 1 0.000    NA#> 2 0.645    NA#> 3 1.290    NA#> 4 1.935    NA#> 5 2.580    NA#> 6 3.225    NAggplot(data = raw_data)+geom_point(aes(x = x,y = value))+theme_bw()+ylab("Height")+xlab("Width")#> Warning: Removed 323 rows containing missing values (geom_point).

Next, we use theget_grooves_bcp() function on the rawdata to get the groove locations. Downsampled data are used here forspeed, but in practice the full data should be used.

# Estimate the groove locations by supplying additional argumentsraw_data<- raw_data[seq(from =1,to =nrow(raw_data),by =30),]cp_gibbs<-get_grooves_bcp(x = raw_data$x,value = raw_data$value,adjust =30,iter =2000)# Estimated groove locationscp_gibbs$groove#> [1]  68.7000 178.0647ggplot(data = raw_data)+geom_point(aes(x = x,y = value))+theme_bw()+ylab("Height")+xlab("Width")+geom_vline(aes(xintercept = cp_gibbs$groove[1]))+geom_vline(aes(xintercept = cp_gibbs$groove[2]))#> Warning: Removed 11 rows containing missing values (geom_point).


[8]ページ先頭

©2009-2025 Movatter.jp