extract_feature_cmps.RdCompute the Congruent Matching Profile Segments (CMPS) score based on two bullet profiles/signatures.
The reference profile will be divided into consecutive, non-overlapping, basis segments of the same length.
Then the number of segments that are congruent matching will be found as the CMPS score.
By default, extract_feature_cmps implements the algorithm with multi-peak inspection at three
different segment scale levels. By setting npeaks_set as a single-length vector, users can switch to the algorithm
with multi-peak inspection at the basis scale level only.
extract_feature_cmps(
x,
y,
seg_length = 50,
Tx = 25,
npeaks_set = c(5, 3, 1),
include = NULL,
outlength = NULL
)a numeric vector, vector of the reference bullet signature/profile that will be divided into basis segments
a numeric vector, vector of the comparison bullet signature/profile
a positive integer, the length of a basis segment
a positive integer, the tolerance zone is +/- Tx
a numeric vector, specify the number of peaks to be found at each segment scale level
If length(npeaks_set) == 1, the algorithm uses multi-peak inspection only at the basis scale level;
If length(npeaks_set) > 1, the algorithm uses multi-peak inspection at
different segment scale levels.
By default, npeaks_set = c(5,3,1). Including more segment scale levels will reduce the number of false positive results
NULL or a vector of character strings indicating what additional information should be included in
the output of extract_feature_cmps. All possible options are: "nseg", "congruent_pos", "congruent_seg",
"congruent_seg_idx", "pos_df", "ccp_list","segments", and "parameters". If one wants to include them all, one can use
include = "full_result". By default, include = NULL and only the CMPS score is returned
NULL or a numeric vector, specify the segment length of each level of the basis segment when the
multi-segment lengths strategy is being used. If outlength = NULL, then the length of a basis segment will be doubled
at each segment level
a numeric value or a list
if include = NULL, returns the CMPS score (a numeric value) only
if include = one or a vector of strings listed above:
nseg: number of basis segments
congruent_seg: a vector of boolean values. TRUE means this basis segment is a congruent matching profile segment (CMPS)
congruent_seg_idx: the indices of all CMPS
pos_df: a dataframe that includes positions of correlation peaks and the CMPS score of these positions
ccp_list: a list of consistent correlation peaks of each basis segment.
segments: a list of all basis segments
parameters: a list that stores all parameters used in the function call
Chen, Zhe, Wei Chu, Johannes A Soons, Robert M Thompson, John Song, and Xuezeng Zhao. 2019. “Fired Bullet Signature Correlation Using the Congruent Matching Profile Segments (CMPS) Method.” Forensic Science International, December, #109964. https://doi.org/10.1016/j.forsciint.2019.109964.
library(tidyverse)
library(cmpsR)
data("bullets")
land2_3 <- bullets$sigs[bullets$bulletland == "2-3"][[1]]
land1_2 <- bullets$sigs[bullets$bulletland == "1-2"][[1]]
# compute cmps
# algorithm with multi-peak insepction at three different segment scale levels
cmps_with_multi_scale <- extract_feature_cmps(land2_3$sig, land1_2$sig, include = "full_result" )
# algorithm with multi-peak inspection at the basis scale level only
cmps_without_multi_scale <- extract_feature_cmps(land2_3$sig, land1_2$sig,
npeaks_set = 5, include = "full_result" )
# Another example
library(tidyverse)
data("bullets")
lands <- unique(bullets$bulletland)
comparisons <- data.frame(expand.grid(land1 = lands[1:6], land2 = lands[7:12]),
stringsAsFactors = FALSE)
comparisons <- comparisons %>%
left_join(bullets %>% select(bulletland, sig1=sigs),
by = c("land1" = "bulletland")) %>%
left_join(bullets %>% select(bulletland, sig2=sigs),
by = c("land2" = "bulletland"))
comparisons <- comparisons %>% mutate(
cmps = purrr::map2(sig1, sig2, .f = function(x, y) {
extract_feature_cmps(x$sig, y$sig, include = "full_result")
})
)
comparisons <- comparisons %>%
mutate(
cmps_score = sapply(comparisons$cmps, function(x) x$CMPS_score),
cmps_nseg = sapply(comparisons$cmps, function(x) x$nseg)
)
cp1 <- comparisons %>% select(land1, land2, cmps_score, cmps_nseg)
cp1
#> land1 land2 cmps_score cmps_nseg
#> 1 1-1 2-1 2 23
#> 2 1-2 2-1 2 22
#> 3 1-3 2-1 1 21
#> 4 1-4 2-1 2 22
#> 5 1-5 2-1 2 23
#> 6 1-6 2-1 16 22
#> 7 1-1 2-2 3 23
#> 8 1-2 2-2 1 22
#> 9 1-3 2-2 1 21
#> 10 1-4 2-2 1 22
#> 11 1-5 2-2 2 23
#> 12 1-6 2-2 3 22
#> 13 1-1 2-3 2 23
#> 14 1-2 2-3 17 22
#> 15 1-3 2-3 3 21
#> 16 1-4 2-3 1 22
#> 17 1-5 2-3 1 23
#> 18 1-6 2-3 1 22
#> 19 1-1 2-4 2 23
#> 20 1-2 2-4 1 22
#> 21 1-3 2-4 14 21
#> 22 1-4 2-4 1 22
#> 23 1-5 2-4 1 23
#> 24 1-6 2-4 2 22
#> 25 1-1 2-5 1 23
#> 26 1-2 2-5 2 22
#> 27 1-3 2-5 1 21
#> 28 1-4 2-5 10 22
#> 29 1-5 2-5 1 23
#> 30 1-6 2-5 1 22
#> 31 1-1 2-6 2 23
#> 32 1-2 2-6 3 22
#> 33 1-3 2-6 1 21
#> 34 1-4 2-6 1 22
#> 35 1-5 2-6 15 23
#> 36 1-6 2-6 1 22