extract_feature_cmps {cmpsR}

Computes the CMPS score of a comparison between two bullet profiles/signatures

Description

Compute 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.

Usage

extract_feature_cmps(
  x,
  y,
  seg_length = 50,
  Tx = 25,
  npeaks_set = c(5, 3, 1),
  include = NULL,
  outlength = NULL
)

Arguments

x

a numeric vector, vector of the reference bullet signature/profile that will be divided into basis segments

y

a numeric vector, vector of the comparison bullet signature/profile

seg_length

a positive integer, the length of a basis segment

Tx

a positive integer, the tolerance zone is ⁠+/- Tx⁠

npeaks_set

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

include

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

outlength

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

Value

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

References

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.

Examples

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