Nothing
## ---- 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")
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.