inst/doc/cmcR_plotReproduction.R

## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
eval=FALSE
)

## ----setup,echo=TRUE,message=FALSE,warning=FALSE------------------------------
#  library(cmcR)
#  library(magrittr)
#  library(ggplot2)
#  library(purrr)
#  library(dplyr)
#  library(tidyr)
#  library(x3ptools)
#  library(rgl)

## -----------------------------------------------------------------------------
#  fadul1.1_id <- "DownloadMeasurement/2d9cc51f-6f66-40a0-973a-a9292dbee36d"
#  # Same source comparison
#  fadul1.2_id <- "DownloadMeasurement/cb296c98-39f5-46eb-abff-320a2f5568e8"
#  
#  # Code to download breech face impressions:
#  nbtrd_url <- "https://tsapps.nist.gov/NRBTD/Studies/CartridgeMeasurement"
#  
#  fadul1.1_raw <- read_x3p(file.path(nbtrd_url,fadul1.1_id))
#  fadul1.2_raw <- read_x3p(file.path(nbtrd_url,fadul1.2_id))

## ---- eval=FALSE--------------------------------------------------------------
#  #apply lowpass filter to reduce noise in scan:
#  surface1 <- fadul1.1_raw %>%
#    cmcR::preProcess_gaussFilter(wavelength = 16,filtertype = "lp")
#  surface2 <- fadul1.2_raw %>%
#    cmcR::preProcess_gaussFilter(wavelength = 16,filtertype = "lp")
#  
#  params <- rgl::r3dDefaults
#  
#  zoom = .7
#  size = c(300,300)
#  
#  params$windowRect <- c(40, 125, 40 + size[1], 125 + size[2])
#  params$userMatrix <- diag(c(1, 1, 1, 1))
#  params$zoom <- zoom
#  
#  #opens blank "canvas" upon which we can add lights, surfaces, etc.
#  open3d(params = params)
#  
#  #removes any previously declared lights in scene
#  rgl.pop("lights")
#  
#  #set-up two lights for scene -- a lot of experimentation possible here
#  light3d(x = -1,y = 1,z = 2,viewpoint.rel = TRUE,ambient = "white",diffuse = "white",specular = "white")
#  light3d(x = 0,y = 0,z = 10,ambient = "grey60",diffuse = "grey50",specular = "grey60",viewpoint.rel = TRUE)
#  
#  #setup surface visualization
#  multiply <- 1 #x3ptools::image_x3p default to exaggerate relief
#  z <- multiply * surface1$surface.matrix # Exaggerate the relief
#  yidx <- ncol(z):1
#  y <- fadul1.1_raw$header.info$incrementY * yidx
#  x <- fadul1.1_raw$header.info$incrementX * (1:nrow(z))
#  
#  # emission, specular, ambient affect how the surface interacts with lights --
#  # again, a lot of possible experimentation
#  surface3d(x, y, z, back = "filled",emission = "grey30",specular = "grey50",ambient = "grey10")
#  
#  x3ptools::x3p_snapshot(file = "bfScanImages/fadul1-1.png")
#  
#  rgl.close()

## ----include=FALSE,eval=FALSE-------------------------------------------------
#  #opens blank "canvas" upon which we can add lights, surfaces, etc.
#  open3d(params = params)
#  
#  #removes any previously declared lights in scene
#  rgl.pop("lights")
#  
#  #set-up two lights for scene -- a lot of experimentation possible here
#  light3d(x = -1,y = 1,z = 2,viewpoint.rel = TRUE,ambient = "white",diffuse = "white",specular = "white")
#  light3d(x = 0,y = 0,z = 10,ambient = "grey60",diffuse = "grey50",specular = "grey60",viewpoint.rel = TRUE)
#  
#  #setup surface visualization
#  multiply <- 1 #x3ptools::image_x3p default to exaggerate relief
#  z <- multiply * surface2$surface.matrix # Exaggerate the relief
#  yidx <- ncol(z):1
#  y <- fadul1.2_raw$header.info$incrementY * yidx
#  x <- fadul1.2_raw$header.info$incrementX * (1:nrow(z))
#  
#  # emission, specular, ambient affect how the surface interacts with lights --
#  # again, a lot of possible experimentation
#  surface3d(x, y, z, back = "filled",emission = "grey30",specular = "grey50",ambient = "grey10")
#  
#  x3ptools::x3p_snapshot(file = "bfScanImages/fadul1-2.png")
#  
#  rgl.close()

## -----------------------------------------------------------------------------
#  plt <- magick::image_append(c(magick::image_read("bfScanImages/fadul1-1.png"),
#                         magick::image_read("bfScanImages/fadul1-2.png")))
#  
#  # magick::image_write(path = "unprocessedScans.png",image = plt)

## ----echo=FALSE,fig.align="center",out.width=600,eval=TRUE--------------------
knitr::include_graphics("https://github.com/jzemmels/vignetteImages/blob/main/unprocessedScans.png?raw=true")

## -----------------------------------------------------------------------------
#  data("fadul1.1_processed","fadul1.2_processed")

## -----------------------------------------------------------------------------
#  #Download a non-matching cartridge case to Fadul 1-1 and Fadul 1-2
#  
#  fadul2.1_raw <- x3ptools::read_x3p("https://tsapps.nist.gov/NRBTD/Studies/CartridgeMeasurement/DownloadMeasurement/8ae0b86d-210a-41fd-ad75-8212f9522f96")
#  
#  fadul2.1_processed <- fadul2.1_raw %>%
#    preProcess_crop(region = "exterior",
#                    radiusOffset = -30) %>%
#    preProcess_crop(region = "interior",
#                    radiusOffset = 200) %>%
#    preProcess_removeTrend(statistic = "quantile",
#                                   tau = .5,
#                                   method = "fn") %>%
#    preProcess_gaussFilter() %>%
#    x3ptools::sample_x3p()

## ----include=FALSE,eval=FALSE-------------------------------------------------
#  #if we want to include more pairs in the comparison
#  fadul2.2 <- x3ptools::read_x3p("https://tsapps.nist.gov/NRBTD/Studies/CartridgeMeasurement/DownloadMeasurement/702956c6-4d7d-4cc5-be62-219b788dc7b0")

## -----------------------------------------------------------------------------
#  plt <- cmcR::x3pListPlot(x3pList = list("Fadul 1-1" = fadul1.1_processed,
#                                   "Fadul 1-2" = fadul1.2_processed,
#                                   "Fadul 2-1" = fadul2.1_processed),
#                    type = "faceted",
#                    rotate = 90,
#                    legend.quantiles = c(0,.01,.2,.5,.8,.99,1))
#  
#  # ggsave("processedScans.png",plot = plt)

## ----echo=FALSE,fig.align="center",out.width=600,eval=TRUE--------------------
knitr::include_graphics("https://github.com/jzemmels/vignetteImages/blob/main/processedScans.png?raw=true")

## -----------------------------------------------------------------------------
#  kmComparisonFeatures <- purrr::map_dfr(seq(-30,30,by = 3),
#                                         ~ comparison_allTogether(reference = fadul1.1_processed,
#                                                                  target = fadul1.2_processed,
#  
#                                                                  theta = .))
#  
#  kmComparisonFeatures_rev <- purrr::map_dfr(seq(-30,30,by = 3),
#                                             ~ comparison_allTogether(reference = fadul1.2_processed,
#                                                                      target = fadul1.1_processed,
#                                                                      theta = .))
#  
#  kmComparison_allCMCs <- kmComparisonFeatures %>%
#    mutate(originalMethodClassif = decision_CMC(cellIndex = cellIndex,
#                                                x = x,
#                                                y = y,
#                                                theta = theta,
#                                                corr = pairwiseCompCor,
#                                                xThresh = 20,
#                                                thetaThresh = 6,
#                                                corrThresh = .5),
#           highCMCClassif = decision_CMC(cellIndex = cellIndex,
#                                                x = x,
#                                                y = y,
#                                                theta = theta,
#                                                corr = pairwiseCompCor,
#                                                xThresh = 20,
#                                                thetaThresh = 6,
#                                                corrThresh = .5,
#                                                tau = 1))
#  
#  kmComparison_allCMCs_rev <- kmComparisonFeatures_rev %>%
#    mutate(originalMethodClassif = decision_CMC(cellIndex = cellIndex,
#                                                x = x,
#                                                y = y,
#                                                theta = theta,
#                                                corr = pairwiseCompCor,
#                                                xThresh = 20,
#                                                thetaThresh = 6,
#                                                corrThresh = .5),
#           highCMCClassif = decision_CMC(cellIndex = cellIndex,
#                                                x = x,
#                                                y = y,
#                                                theta = theta,
#                                                corr = pairwiseCompCor,
#                                                xThresh = 20,
#                                                thetaThresh = 6,
#                                                corrThresh = .5,
#                                                tau = 1))
#  
#  knmComparisonFeatures <- purrr::map_dfr(seq(-30,30,by = 3),
#                                         ~ comparison_allTogether(reference = fadul1.1_processed,
#                                                                  target = fadul2.1_processed,
#  
#                                                                  theta = .))
#  
#  knmComparisonFeatures_rev <- purrr::map_dfr(seq(-30,30,by = 3),
#                                             ~ comparison_allTogether(reference = fadul2.1_processed,
#                                                                      target = fadul1.1_processed,
#                                                                      theta = .))
#  
#  knmComparison_allCMCs <- knmComparisonFeatures %>%
#    mutate(originalMethodClassif = decision_CMC(cellIndex = cellIndex,
#                                                x = x,
#                                                y = y,
#                                                theta = theta,
#                                                corr = pairwiseCompCor,
#                                                xThresh = 20,
#                                                thetaThresh = 6,
#                                                corrThresh = .5),
#           highCMCClassif = decision_CMC(cellIndex = cellIndex,
#                                                x = x,
#                                                y = y,
#                                                theta = theta,
#                                                corr = pairwiseCompCor,
#                                                xThresh = 20,
#                                                thetaThresh = 6,
#                                                corrThresh = .5,
#                                                tau = 1))
#  
#  knmComparison_allCMCs_rev <- knmComparisonFeatures_rev %>%
#    mutate(originalMethodClassif = decision_CMC(cellIndex = cellIndex,
#                                                x = x,
#                                                y = y,
#                                                theta = theta,
#                                                corr = pairwiseCompCor,
#                                                xThresh = 20,
#                                                thetaThresh = 6,
#                                                corrThresh = .5),
#           highCMCClassif = decision_CMC(cellIndex = cellIndex,
#                                                x = x,
#                                                y = y,
#                                                theta = theta,
#                                                corr = pairwiseCompCor,
#                                                xThresh = 20,
#                                                thetaThresh = 6,
#                                                corrThresh = .5,
#                                                tau = 1))

## -----------------------------------------------------------------------------
#  kmCMCPlot <- cmcR::cmcPlot(reference = fadul1.1_processed,
#                              target = fadul1.2_processed,
#                              reference_v_target_CMCs = kmComparison_allCMCs,
#                              target_v_reference_CMCs = kmComparison_allCMCs_rev,
#                              type = "faceted",
#                              x3pNames = c("Fadul 1-1","Fadul 2-1"),
#                              legend.quantiles = c(0,.01,.2,.5,.8,.99,1),
#                              cell.colors = c("#a60b00","#1b03a3"),
#                              cell.alpha = .15,
#                              na.value = "gray80") %>%
#    map(~ . + theme(strip.text = element_blank()))
#  
#  kmLegend_originalCMC <- cowplot::get_legend(kmCMCPlot$originalMethodCMCs_reference_v_target +
#                                     theme(legend.direction = "horizontal"))
#  
#  km_originalCMC_reference_v_target <- kmCMCPlot$originalMethodCMCs_reference_v_target +
#    theme(legend.position = "none",
#          plot.margin=unit(c(-.05,-.5,-.05,-.5), "cm"),
#          plot.title = element_blank())
#  
#  km_originalCMC_target_v_reference <- kmCMCPlot$originalMethodCMCs_target_v_reference +
#    theme(legend.position = "none",
#          plot.margin=unit(c(-.05,-.5,-.05,-.5), "cm"),
#          plot.title = element_blank())
#  
#  km_originalCMCPlot_bothDirections <- ggplot(data.frame(a = 1)) +
#    theme_void() +
#    coord_cartesian(xlim = c(1,10),
#                    ylim = c(1,11),
#                    expand = FALSE) +
#    annotation_custom(ggplotGrob(km_originalCMC_reference_v_target),
#                      xmin = 1,xmax = 10,ymin = 6.2,ymax = 11) +
#    annotation_custom(ggplotGrob(km_originalCMC_target_v_reference),
#                      xmin = 1,xmax = 10,ymin = 2,ymax = 6.2) +
#    annotation_custom(kmLegend_originalCMC,
#                      xmin = 1,xmax = 10,ymin = 1.45,ymax = 1.45) +
#    annotate("text",x = 3.85,y = 8.15,size = 5,label = "Fadul 1-1") +
#    annotate("text",x = 3.85,y = 4,size = 5,label = "Fadul 1-1") +
#    annotate("text",x = 7.05,y = 8.15,size = 5,label = "Fadul 1-2") +
#    annotate("text",x = 7.05,y = 4,size = 5,label = "Fadul 1-2")
#  
#  # ggsave("kmOriginalmethodCMCs.png",km_originalCMCPlot_bothDirections)

## ----echo=FALSE,fig.align="center",out.width=600,eval=TRUE--------------------
knitr::include_graphics("https://github.com/jzemmels/vignetteImages/blob/main/kmOriginalmethodCMCs.png?raw=true")

## -----------------------------------------------------------------------------
#  kmLegend_highCMC <- cowplot::get_legend(kmCMCPlot$highCMC_reference_v_target +
#                                     theme(legend.direction = "horizontal"))
#  
#  km_highCMC_reference_v_target <- kmCMCPlot$highCMC_reference_v_target +
#    theme(legend.position = "none",
#          plot.margin=unit(c(-.05,-.5,-.05,-.5), "cm"),
#          plot.title = element_blank())
#  
#  km_highCMC_target_v_reference <- kmCMCPlot$highCMC_target_v_reference +
#    theme(legend.position = "none",
#          plot.margin=unit(c(-.05,-.5,-.05,-.5), "cm"),
#          plot.title = element_blank())
#  
#  km_highCMCCMCPlot_bothDirections <- ggplot(data.frame(a = 1)) +
#    theme_void() +
#    coord_cartesian(xlim = c(1,10),
#                    ylim = c(1,11),
#                    expand = FALSE) +
#    annotation_custom(ggplotGrob(km_highCMC_reference_v_target),
#                      xmin = 1.1,xmax = 10,ymin = 6.55,ymax = 11) +
#    annotation_custom(ggplotGrob(km_highCMC_target_v_reference),
#                      xmin = 1,xmax = 10,ymin = 2,ymax = 6.55) +
#    annotation_custom(kmLegend_highCMC,
#                      xmin = 1,xmax = 10,ymin = 1.45,ymax = 1.45) +
#    annotate("text",x = 3.65,y = 8.65,size = 5,label = "Fadul 1-1") +
#    annotate("text",x = 3.65,y = 4,size = 5,label = "Fadul 1-1") +
#    annotate("text",x = 7.25,y = 8.65,size = 5,label = "Fadul 1-2") +
#    annotate("text",x = 7.25,y = 4,size = 5,label = "Fadul 1-2")
#  
#  # ggsave("kmHighCMCs.png",km_highCMCCMCPlot_bothDirections)

## ----echo=FALSE,fig.align="center",out.width=600,eval=TRUE--------------------
knitr::include_graphics("https://github.com/jzemmels/vignetteImages/blob/main/kmHighCMCs.png?raw=true")

## -----------------------------------------------------------------------------
#  knmCMCPlot <- cmcR::cmcPlot(reference = fadul1.1_processed,
#                              target = fadul2.1_processed,
#                              reference_v_target_CMCs = knmComparison_allCMCs,
#                              target_v_reference_CMCs = knmComparison_allCMCs_rev,
#                              type = "faceted",
#                              x3pNames = c("Fadul 1-1","Fadul 2-1"),
#                              legend.quantiles = c(0,.01,.2,.5,.8,.99,1),
#                              cell.colors = c("#a60b00","#1b03a3"),
#                              cell.alpha = .15,
#                              na.value = "gray80") %>%
#    map(~ . + theme(strip.text = element_blank()))
#  
#  knmLegend <- cowplot::get_legend(knmCMCPlot$originalMethodCMCs_reference_v_target +
#                                     theme(legend.direction = "horizontal"))
#  
#  knm_reference_v_target <- knmCMCPlot$originalMethodCMCs_reference_v_target +
#    theme(legend.position = "none",
#          plot.margin=unit(c(-.05,-.5,-.05,-.5), "cm"),
#          plot.title = element_blank())
#  
#  knm_target_v_reference <- knmCMCPlot$originalMethodCMCs_target_v_reference +
#    theme(legend.position = "none",
#          plot.margin=unit(c(-.05,-.5,-.05,-.5), "cm"),
#          plot.title = element_blank())
#  
#  knm_cmcPlot_bothDirections <- ggplot(data.frame(a = 1)) +
#    theme_void() +
#    coord_cartesian(xlim = c(1,10),
#                    ylim = c(1,11),
#                    expand = FALSE) +
#    annotation_custom(ggplotGrob(knm_reference_v_target),
#                      xmin = 1,xmax = 10,ymin = 6.5,ymax = 11) +
#    annotation_custom(ggplotGrob(knm_target_v_reference),
#                      xmin = 1,xmax = 10,ymin = 2,ymax = 6.5) +
#    annotation_custom(knmLegend,
#                      xmin = 1,xmax = 10,ymin = 1.45,ymax = 1.45) +
#    annotate("text",x = 3.75,y = 8.65,size = 5,label = "Fadul 1-1") +
#    annotate("text",x = 3.75,y = 4,size = 5,label = "Fadul 1-1") +
#    annotate("text",x = 7.45,y = 8.65,size = 5,label = "Fadul 2-1") +
#    annotate("text",x = 7.45,y = 4,size = 5,label = "Fadul 2-1")
#  
#  # ggsave("knmOriginalMethodCMCs.png",knm_cmcPlot_bothDirections)

## ----echo=FALSE,fig.align="center",out.width=600,eval=TRUE--------------------
knitr::include_graphics("https://github.com/jzemmels/vignetteImages/blob/main/knmOriginalMethodCMCs.png?raw=true")

Try the cmcR package in your browser

Any scripts or data that you put into this service are public.

cmcR documentation built on Dec. 10, 2022, 5:06 p.m.