Nothing
## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
eval=FALSE
)
## ----setup,message=FALSE,warning=TRUE-----------------------------------------
# library(cmcR)
# library(dplyr)
# library(ggplot2)
# library(purrr)
# library(tidyr)
# library(gridExtra)
## -----------------------------------------------------------------------------
# data("fadul1.1_processed")
# data("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()
## ---- echo=FALSE, fig.align = 'center'----------------------------------------
# plt <- cmcR::x3pListPlot(list("Fadul 1-1" = fadul1.1_processed,
# "Fadul 1-2" = fadul1.2_processed,
# "Fadul 2-1" = fadul2.1_processed))
#
# # ggsave("derivatives/cmcPlot.png")
## ---- echo=FALSE,eval=TRUE,out.width=600,fig.align="center"-------------------
knitr::include_graphics("https://github.com/jzemmels/vignetteImages/blob/main/cmcPlot.png?raw=true")
## ----include=FALSE------------------------------------------------------------
# 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))
## ----include=FALSE------------------------------------------------------------
# knmCMCPlot <- cmcR::cmcPlot(fadul1.1_processed,
# 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")
#
# kmCMCPlot <- cmcR::cmcPlot(fadul1.1_processed,
# fadul1.2_processed,
# reference_v_target_CMCs = kmComparison_allCMCs,
# target_v_reference_CMCs = knmComparison_allCMCs_rev,
# x3pNames = c("Fadul 1-1","Fadul 1-2"),
# legend.quantiles = c(0,.01,.2,.5,.8,.99,1),
# cell.colors = c("#a60b00","#1b03a3"),
# cell.alpha = .15,
# na.value = "gray80")
#
# knmCMCPlot_list_comparison1to2 <- cmcR::cmcPlot(fadul1.1_processed,
# fadul2.1_processed,
# reference_v_target_CMCs = knmComparison_allCMCs,
# target_v_reference_CMCs = knmComparison_allCMCs_rev,
# type = "list",
# x3pNames = c("Fadul 1-1","Fadul 2-1"),
# legend.quantiles = c(0,.01,.2,.5,.8,.99,1),
# cell.colors = c("black","black"),
# cell.alpha = .15,
# na.value = "gray90")
#
# kmCMCPlot_list_comparison1to2 <- cmcR::cmcPlot(fadul1.1_processed,
# fadul1.2_processed,
# reference_v_target_CMCs = kmComparison_allCMCs,
# target_v_reference_CMCs = knmComparison_allCMCs_rev,
# x3pNames = c("Fadul 1-1","Fadul 1-2"),
# legend.quantiles = c(0,.01,.2,.5,.8,.99,1),
# cell.colors = c("black","black"),
# cell.alpha = .15,
# na.value = "gray90",
# type = "list")
## ----include=FALSE------------------------------------------------------------
# kmComparison_xData <- kmComparisonFeatures %>%
# mutate(direction = "comparison_1to2") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# mutate(med_x = median(x),
# med_y = median(y)) %>%
# mutate(x_threshMinus = med_x - 20,
# x_threshPlus = med_x + 20,
# y_threshMinus = med_y - 20,
# y_threshPlus = med_y + 20) %>%
# mutate(Classification = factor(ifelse(abs(x - med_x) <= 20,"Congruent","Not Congruent"),
# levels = c("Not Congruent","Congruent")))
#
# kmComparison_yData <- kmComparisonFeatures %>%
# mutate(direction = "comparison_1to2") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# mutate(med_x = median(x),
# med_y = median(y)) %>%
# mutate(x_threshMinus = med_x - 20,
# x_threshPlus = med_x + 20,
# y_threshMinus = med_y - 20,
# y_threshPlus = med_y + 20) %>%
# mutate(Classification = factor(ifelse(abs(y - med_y) <= 20,"Congruent","Not Congruent"),
# levels = c("Not Congruent","Congruent")))
#
# kmComparison_pairwiseCompCorData <- kmComparisonFeatures %>%
# mutate(direction = "comparison_1to2") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# mutate(pairwiseCompCor_thresh = .5) %>%
# mutate(Classification = factor(ifelse(pairwiseCompCor >= .5,"Congruent","Not Congruent"),
# levels = c("Not Congruent","Congruent")))
#
# kmComparison_thetaData <- kmComparisonFeatures %>%
# mutate(direction = "comparison_1to2") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# mutate(med_theta = median(theta)) %>%
# mutate(theta_threshMinus = med_theta - 6,
# theta_threshPlus = med_theta + 6) %>%
# mutate(Classification = ifelse(abs(theta - med_theta) <= 6, "Congruent","Not Congruent")) %>%
# mutate(Classification = factor(Classification,levels = c("Not Congruent","Congruent")))
#
# knmComparison_xData <- knmComparisonFeatures %>%
# mutate(direction = "comparison_1to2") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# mutate(med_x = median(x),
# med_y = median(y)) %>%
# mutate(x_threshMinus = med_x - 20,
# x_threshPlus = med_x + 20,
# y_threshMinus = med_y - 20,
# y_threshPlus = med_y + 20) %>%
# mutate(Classification = factor(ifelse(abs(x - med_x) <= 20,"Congruent","Not Congruent"),
# levels = c("Not Congruent","Congruent")))
#
# knmComparison_yData <- knmComparisonFeatures %>%
# mutate(direction = "comparison_1to2") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# mutate(med_x = median(x),
# med_y = median(y)) %>%
# mutate(x_threshMinus = med_x - 20,
# x_threshPlus = med_x + 20,
# y_threshMinus = med_y - 20,
# y_threshPlus = med_y + 20) %>%
# mutate(Classification = factor(ifelse(abs(y - med_y) <= 20,"Congruent","Not Congruent"),
# levels = c("Not Congruent","Congruent")))
#
# knmComparison_pairwiseCompCorData <- knmComparisonFeatures %>%
# mutate(direction = "comparison_1to2") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# mutate(pairwiseCompCor_thresh = .5) %>%
# mutate(Classification = factor(ifelse(pairwiseCompCor >= .5,"Congruent","Not Congruent"),
# levels = c("Not Congruent","Congruent")))
#
# knmComparison_thetaData <- knmComparisonFeatures %>%
# mutate(direction = "comparison_1to2") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# mutate(med_theta = median(theta)) %>%
# mutate(theta_threshMinus = med_theta - 6,
# theta_threshPlus = med_theta + 6) %>%
# mutate(Classification = ifelse(abs(theta - med_theta) <= 6, "Congruent","Not Congruent")) %>%
# mutate(Classification = factor(Classification,levels = c("Not Congruent","Congruent")))
## ----include=FALSE,fig.height=1-----------------------------------------------
# kmComparison_xData_plot <- kmComparison_xData %>%
# ggplot() +
# geom_histogram(aes(x = x,
# fill = Classification),
# alpha = .7,
# binwidth = 1
# ) +
# scale_fill_manual(values = c("#a60b00","#1b03a3")) +
# geom_ribbon(mapping = aes(y = seq(0,3.5,length.out = 27),
# xmin = med_x - 20.5,
# xmax = med_x + 20.5),
# fill = "#7570b3",
# alpha = .3) +
# theme_bw() +
# scale_x_continuous(expression(paste("Estimated horizontal translation ",Delta,"x")),
# breaks = seq(-100,100,by = 50),
# limits = c(-101,101),
# oob = scales::oob_keep
# ) +
# scale_y_continuous(limits = c(0,2.5)) +
# ylab("# Cell Pairs") +
# theme(legend.position = c(1, 1),
# legend.justification = c(1, 1),
# legend.direction = "horizontal",
# legend.background = element_blank(),
# legend.text = element_text(size = 7),
# legend.title = element_text(size = 7),
# axis.text = element_text(size = 4),
# axis.title.x = element_text(size = 6),
# axis.title.y = element_text(size = 4),
# plot.margin=unit(c(0,.1,0,.1), "cm"),
# legend.key.size = unit(0.3, "cm"))
#
# pltLegend_horizontal <- cowplot::get_legend(kmComparison_xData_plot)
#
# kmComparison_xData_plot <- kmComparison_xData_plot +
# theme(legend.position = c(1, 1),
# legend.justification = c(1, 1),
# legend.direction = "vertical",
# legend.background = element_blank(),
# legend.text = element_text(size = 7),
# legend.title = element_blank(),
# axis.text = element_text(size = 4),
# axis.title.x = element_text(size = 6),
# axis.title.y = element_text(size = 4),
# plot.margin=unit(c(0,.1,0,.1), "cm"),
# legend.key.size = unit(0.3, "cm"))
#
# pltLegend_vertical_leftAligned <- cowplot::get_legend(kmComparison_xData_plot)
#
# kmComparison_xData_plot <- kmComparison_xData_plot +
# theme(legend.position = c(1, 1),
# legend.justification = c(1, 1),
# legend.direction = "vertical",
# legend.background = element_blank(),
# legend.text = element_text(size = 7),
# legend.title = element_blank(),
# axis.text = element_text(size = 4),
# axis.title.x = element_text(size = 6),
# axis.title.y = element_text(size = 4),
# plot.margin=unit(c(0,.1,0,.1), "cm"),
# legend.key.size = unit(0.3, "cm")) +
# guides(fill = guide_legend(label.position = "left",label.hjust = 1))
#
# pltLegend_vertical_rightAligned <- cowplot::get_legend(kmComparison_xData_plot)
#
# kmComparison_xData_plot <- kmComparison_xData_plot +
# theme(legend.position = "none")
#
# knmComparison_xData_plot <- knmComparison_xData %>%
# ggplot() +
# geom_histogram(aes(x = x,
# fill = Classification),
# alpha = .7,
# binwidth = 1
# ) +
# scale_fill_manual(values = c("#a60b00","#1b03a3")) +
# geom_ribbon(mapping = aes(y = seq(0,3.5,length.out = 29),
# xmin = med_x - 20,
# xmax = med_x + 20),
# fill = "#7570b3",
# alpha = .3) +
# theme_bw() +
# scale_x_continuous(expression(paste("Estimated horizontal translation ",Delta,"x")),
# breaks = seq(-100,100,by = 50),
# limits = c(-101,101),na.value = 0
# ) +
# scale_y_continuous(limits = c(0,2.5)) +
# ylab("# Cell Pairs") +
# theme(legend.position = "none",
# axis.text = element_text(size = 4),
# axis.title.x = element_text(size = 6), axis.title.y = element_text(size = 4)
# ,plot.margin=unit(c(0,.1,0,.1), "cm")
# )
#
# kmComparison_yData_plot <- kmComparison_yData %>%
# ggplot() +
# geom_histogram(aes(x = y,
# fill = Classification),
# alpha = .7,
# binwidth = 1
# ) +
# scale_fill_manual(values = c("#a60b00","#1b03a3")) +
# geom_ribbon(mapping = aes(y = seq(0,3.5,length.out = 27),
# xmin = med_y - 20,
# xmax = med_y + 20),
# fill = "#7570b3",
# alpha = .3) +
# theme_bw() +
# scale_x_continuous(expression(paste("Estimated horizontal translation ",Delta,"y")),
# breaks = seq(-100,100,by = 50),
# limits = c(-101,101),na.value = 0
# ) +
# scale_y_continuous(limits = c(0,2.5)) +
# ylab("# Cell Pairs") +
# theme(legend.position = "none",
# axis.text = element_text(size = 4),
# axis.title.x = element_text(size = 6), axis.title.y = element_text(size = 4)
# ,plot.margin=unit(c(0,.1,0,.1), "cm")
# )
#
# knmComparison_yData_plot <- knmComparison_yData %>%
# ggplot() +
# geom_histogram(aes(x = y,
# fill = Classification),
# alpha = .7,
# binwidth = 1
# ) +
# scale_fill_manual(values = c("#a60b00","#1b03a3")) +
# geom_ribbon(mapping = aes(y = seq(0,3.5,length.out = 29),
# xmin = med_y - 20.5,
# xmax = med_y + 20.5),
# fill = "#7570b3",
# alpha = .3) +
# theme_bw() +
# scale_x_continuous(expression(paste("Estimated horizontal translation ",Delta,"y")),
# breaks = seq(-100,100,by = 50),
# limits = c(-101,101),oob = scales::squish
# ) +
# scale_y_continuous(limits = c(0,2.5)) +
# ylab("# Cell Pairs") +
# theme(legend.position = "none",
# axis.text = element_text(size = 4),
# axis.title.x = element_text(size = 6), axis.title.y = element_text(size = 4)
# ,plot.margin=unit(c(0,.1,0,.1), "cm")
# )
#
# kmComparison_thetaData_plot <- kmComparison_thetaData %>%
# ggplot() +
# geom_bar(aes(x = theta,
# fill = Classification),
# alpha = .7) +
# scale_fill_manual(values = c("#a60b00","#1b03a3")) +
# geom_ribbon(aes(y = seq(0,12,length.out = 27),
# xmin = med_theta - 7.5,
# xmax = med_theta + 7.5),
# fill = "#7570b3",
# alpha = .3) +
# theme_bw() +
# scale_x_continuous(expression(paste("Estimated rotation angle ", theta)),
# breaks = seq(-30,30,by = 15),
# limits = c(-32,32)) +
# scale_y_continuous(limits = c(0,7),
# breaks = seq(0,7,by = 1)) +
# ylab("# Cell Pairs") +
# theme(legend.position = "none",
# axis.text = element_text(size = 4),
# axis.title.x = element_text(size = 6), axis.title.y = element_text(size = 4)
# ,plot.margin=unit(c(0,.1,0,.1), "cm")
# )
#
# knmComparison_thetaData_plot <- knmComparison_thetaData %>%
# ggplot() +
# geom_bar(aes(x = theta,
# fill = Classification),
# alpha = .7) +
# scale_fill_manual(values = c("#a60b00","#1b03a3")) +
# geom_ribbon(aes(y = seq(0,12,length.out = 29),
# xmin = med_theta - 6,
# xmax = med_theta + 6),
# fill = "#7570b3",
# alpha = .3) +
# theme_bw() +
# scale_x_continuous(expression(paste("Estimated rotation angle ", theta)),
# breaks = seq(-30,30,by = 15),
# limits = c(-32,32)) +
# scale_y_continuous(limits = c(0,7),
# breaks = seq(0,7,by = 1)) +
# ylab("# Cell Pairs") +
# theme(legend.position = "none",
# axis.text = element_text(size = 4),
# axis.title.x = element_text(size = 6), axis.title.y = element_text(size = 4)
# ,plot.margin=unit(c(0,.1,0,.1), "cm")
# )
#
# kmComparison_pairwiseCompCorData_plot <- kmComparison_pairwiseCompCorData %>%
# ggplot(aes(x = pairwiseCompCor,fill = Classification)) +
# geom_histogram( binwidth = .01) +
# scale_fill_manual(values = c("#a60b00","#1b03a3")) +
# geom_vline(aes(xintercept = pairwiseCompCor_thresh),
# colour = "#7570b3") +
# geom_ribbon(mapping = aes(y = seq(-1,4,length.out = 27),
# xmin = pairwiseCompCor_thresh,
# xmax = 1),
# fill = "#7570b3",
# alpha = .3) +
# theme_bw() +
# scale_x_continuous(expression(paste("Estimated CCF"[max])),
# breaks = seq(0,1,by = .5)) +
# coord_cartesian(xlim = c(0,1),
# ylim = c(0,3.5),
# expand = FALSE) +
# ylab("# Cell Pairs") +
# theme(legend.position = "none",
# axis.text = element_text(size = 4),
# axis.title.x = element_text(size = 6), axis.title.y = element_text(size = 4)
# ,plot.margin=unit(c(0,.1,0,.1), "cm")
# )
#
# knmComparison_pairwiseCompCorData_plot <- knmComparison_pairwiseCompCorData %>%
# ggplot(aes(x = pairwiseCompCor,fill = Classification)) +
# geom_histogram(binwidth = .01) +
# scale_fill_manual(values = c("#a60b00","#1b03a3")) +
# geom_vline(aes(xintercept = pairwiseCompCor_thresh),
# colour = "#7570b3") +
# geom_ribbon(mapping = aes(y = seq(0,4,length.out = 29),
# xmin = pairwiseCompCor_thresh,
# xmax = 1),
# fill = "#7570b3",
# alpha = .3) +
# theme_bw() +
# scale_x_continuous(expression(paste("Estimated CCF"[max])),
# breaks = seq(0,1,by = .5)) +
# coord_cartesian(xlim = c(0,1),
# ylim = c(0,3.5),
# expand = FALSE) +
# ylab("# Cell Pairs") +
# theme(legend.position = "none",
# axis.text = element_text(size = 4),
# axis.title.x = element_text(size = 6), axis.title.y = element_text(size = 4)
# ,plot.margin=unit(c(0,.1,0,.1), "cm")
# )
## ----include=FALSE------------------------------------------------------------
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-1`$layers <- kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-1`$layers[-3]
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-2`$layers <- kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-2`$layers[-3]
# knmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 2-1`$layers <- knmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 2-1`$layers[-3]
#
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-1` <- kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-1` +
# ggplot2::theme(legend.position = "none",
# plot.margin=unit(c(0,-.5,0,-.5), "cm"),
# plot.title = element_blank()) +
# coord_fixed(xlim = c(-400,3600), ylim = c(-100,3800)) +
# annotate(geom = "text",x = 3300/2,y = 3100/2,label = "Fadul 1-1",size = 4)
#
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-2` <- kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-2` +
# ggplot2::theme(legend.position = "none",
# plot.margin=unit(c(0,-.5,0,-.5), "cm"),
# plot.title = element_blank()) +
# coord_fixed(xlim = c(-400,3600), ylim = c(-100,3800)) +
# annotate(geom = "text",x = 3300/2,y = 3100/2,label = "Fadul 1-2",size = 4)
#
# knmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 2-1` <- knmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 2-1` +
# ggplot2::theme(legend.position = "none",
# plot.margin=unit(c(0,-.5,0,-.5), "cm"),
# plot.title = element_blank()) +
# coord_fixed(xlim = c(-400,3600), ylim = c(-100,3800)) +
# annotate(geom = "text",x = 3300/2,y = 3100/2,label = "Fadul 2-1",size = 4)
## ----warning=TRUE,message=FALSE,echo=FALSE,fig.width = 8, fig.align = 'center'----
# horizontalTranslation_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 2.5,label = " Horizontal \n Translation") +
# theme_void()
#
# verticalTranslation_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 2.5,label = " Vertical \n Translation") +
# theme_void()
#
# rotation_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 2.5,label = "Rotation") +
# theme_void()
#
# pairwiseCompCor_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 2.5,label = expression(paste("CCF"[max]))) +
# theme_void()
#
# blank_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 2,label = " ") +
# theme_void()
#
# # Some internal call to is.na within grid.arrange is throwing a warning for the
# # pairwiseCompCor_label since it contains an expression. Since this isn't
# # anything wrong with vignette, we'll just suppress it
# suppressWarnings({
# plt <- gridExtra::arrangeGrob(kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-1`,
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-2`,
# knmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 2-1`,
# horizontalTranslation_label,
# kmComparison_xData_plot,
# knmComparison_xData_plot,
# verticalTranslation_label,
# kmComparison_yData_plot,
# knmComparison_yData_plot,
# rotation_label,
# kmComparison_thetaData_plot,
# knmComparison_thetaData_plot,
# pairwiseCompCor_label,
# kmComparison_pairwiseCompCorData_plot,
# knmComparison_pairwiseCompCorData_plot,
# blank_label,
# blank_label,
# pltLegend_horizontal,
# heights = unit(c(7,4,4,4,4,2),units = "null"),
# widths = unit(c(1,1.5,1.5),units = "null"))
#
# # ggsave("derivatives/originalMethodResults.png",plt)
# })
## ---- echo=FALSE,eval=TRUE,out.width=600,fig.align="center"-------------------
knitr::include_graphics("https://github.com/jzemmels/vignetteImages/blob/main/originalMethodResults.png?raw=true")
## ----include=FALSE------------------------------------------------------------
# #PC plots look best when the values are rescaled to be between 0 and 1. We want
# #to rescale x, y, and theta, but not the CCF (which is already between 0 and 1,
# #effectively). This code the rescaling desired
#
# medianData_comparison1to2 <- kmComparisonFeatures %>%
# mutate(direction = "comparison_1to2") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# select(-c(cellIndex,fft_ccf,pairwiseCompCor)) %>%
# summarise(x = median(x),
# y = median(y),
# theta = median(theta),
# pairwiseCompCor = .75,
# cellNum = 100)
#
# yminData_comparison1to2 <- medianData_comparison1to2 %>%
# mutate(x = x - 20,
# y = y - 20,
# theta = theta - 6,
# pairwiseCompCor = .5,
# cellNum = 99)
#
# ymaxData_comparison1to2 <- medianData_comparison1to2 %>%
# mutate(x = x + 20,
# y = y + 20,
# theta = theta + 6,
# pairwiseCompCor = 1,
# cellNum = 101)
#
# congruentData_comparison1to2 <- kmComparisonFeatures %>%
# mutate(direction = "comparison_1to2") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# select(-c(cellIndex,fft_ccf,pairwiseCompCor)) %>%
# mutate(cellNum = 1:nrow(.)) %>%
# bind_rows(yminData_comparison1to2,
# medianData_comparison1to2,
# ymaxData_comparison1to2) %>%
# select(-pairwiseCompCor) %>%
# pivot_longer(cols = c(x,y,theta),
# names_to = "parameter") %>%
# group_by(parameter) %>%
# mutate(value = scales::rescale(value)) %>%
# bind_rows(kmComparisonFeatures %>%
# mutate(direction = "comparison_1to2") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# select(-c(cellIndex,fft_ccf)) %>%
# mutate(cellNum = 1:nrow(.)) %>%
# bind_rows(yminData_comparison1to2,
# medianData_comparison1to2,
# ymaxData_comparison1to2) %>%
# select(-c(x,y,theta)) %>%
# mutate(parameter = "pairwiseCompCor") %>%
# rename(value = pairwiseCompCor)) %>%
# arrange(cellNum)
#
# extremaData_comparison1to2 <- congruentData_comparison1to2 %>%
# filter(cellNum %in% c(99,100,101)) %>%
# ungroup() %>%
# select(-c(cellNum)) %>%
# mutate(name = rep(c("ymin","ymed","ymax"),each = 4)) %>%
# pivot_wider(id_cols = parameter,
# names_from = name,
# values_from = value)
#
# medianData_comparison2to1 <- kmComparisonFeatures_rev %>%
# mutate(direction = "comparison_2to1") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# select(-c(cellIndex,fft_ccf,pairwiseCompCor)) %>%
# summarise(x = median(x),
# y = median(y),
# theta = median(theta),
# pairwiseCompCor = .75,
# cellNum = 100)
#
# yminData_comparison2to1 <- medianData_comparison2to1 %>%
# mutate(x = x - 20,
# y = y - 20,
# theta = theta - 6,
# pairwiseCompCor = .5,
# cellNum = 99)
#
# ymaxData_comparison2to1 <- medianData_comparison2to1 %>%
# mutate(x = x + 20,
# y = y + 20,
# theta = theta + 6,
# pairwiseCompCor = 1,
# cellNum = 101)
#
# congruentData_comparison2to1 <- kmComparisonFeatures_rev %>%
# mutate(direction = "comparison_2to1") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# select(-c(cellIndex,fft_ccf,pairwiseCompCor)) %>%
# mutate(cellNum = 1:nrow(.)) %>%
# bind_rows(yminData_comparison2to1,
# medianData_comparison2to1,
# ymaxData_comparison2to1) %>%
# select(-pairwiseCompCor) %>%
# pivot_longer(cols = c(x,y,theta),
# names_to = "parameter") %>%
# group_by(parameter) %>%
# mutate(value = scales::rescale(value)) %>%
# bind_rows(kmComparisonFeatures %>%
# mutate(direction = "comparison_2to1") %>%
# group_by(cellIndex) %>%
# filter(pairwiseCompCor == max(pairwiseCompCor)) %>%
# ungroup() %>%
# select(-c(cellIndex,fft_ccf)) %>%
# mutate(cellNum = 1:nrow(.)) %>%
# bind_rows(yminData_comparison2to1,
# medianData_comparison2to1,
# ymaxData_comparison2to1) %>%
# select(-c(x,y,theta)) %>%
# mutate(parameter = "pairwiseCompCor") %>%
# rename(value = pairwiseCompCor)) %>%
# arrange(cellNum)
#
# extremaData_comparison2to1 <- congruentData_comparison2to1 %>%
# filter(cellNum %in% c(99,100,101)) %>%
# ungroup() %>%
# select(-c(cellNum)) %>%
# mutate(name = rep(c("ymin","ymed","ymax"),each = 4)) %>%
# pivot_wider(id_cols = parameter,
# names_from = name,
# values_from = value)
## ---- include=FALSE-----------------------------------------------------------
# originalMethod_comparison1to2_pcp <- congruentData_comparison1to2 %>%
# filter(cellNum < 90) %>%
# ungroup() %>%
# pivot_wider(id_cols = c(cellNum,parameter),
# names_from = parameter,
# values_from = value) %>%
# mutate(Classification = case_when(x >= extremaData_comparison1to2[1,"ymin"][[1]] & x <= extremaData_comparison1to2[1,"ymax"][[1]] &
# y >= extremaData_comparison1to2[2,"ymin"][[1]] & y <= extremaData_comparison1to2[2,"ymax"][[1]] &
# theta >= extremaData_comparison1to2[3,"ymin"][[1]] & theta <= extremaData_comparison1to2[3,"ymax"][[1]] &
# pairwiseCompCor >= extremaData_comparison1to2[4,"ymin"][[1]] & pairwiseCompCor <= extremaData_comparison1to2[4,"ymax"][[1]] ~ "Congruent",
# TRUE ~ "Not Congruent")) %>%
# pivot_longer(cols = c(x,y,theta,pairwiseCompCor),
# names_to = "parameter") %>%
# mutate(parameter = factor(parameter,c("x","y","theta","pairwiseCompCor")),
# Classification = factor(Classification,levels = c("Congruent","Not Congruent"))) %>%
# ggplot() +
# scale_colour_manual(values = c("#1b03a3","#a60b00")) +
# geom_line(aes(x = parameter,y = value,group = cellNum,colour = Classification),
# size = .1) +
# geom_tile(data = extremaData_comparison1to2,
# aes(x = parameter,
# y = ymed,
# width = .25,
# height = ymax - ymin),
# fill = "#7570b3",
# colour = "black",
# alpha = .4) +
# theme_bw() +
# theme(axis.text.y = element_blank(),
# axis.title.y = element_blank(),
# axis.title.x = element_blank(),
# axis.ticks = element_blank(),
# legend.position = "none",
# plot.margin = unit(c(.55,0,0,0), "cm")) +
# scale_x_discrete(labels = c(expression(paste(Delta, "x")),
# expression(paste(Delta, "y")),
# expression(theta),
# expression("CCF"[max])))
#
# originalMethod_comparison2to1_pcp <- congruentData_comparison2to1 %>%
# filter(cellNum < 90) %>%
# ungroup() %>%
# pivot_wider(id_cols = c(cellNum,parameter),
# names_from = parameter,
# values_from = value) %>%
# mutate(Classification = case_when(x >= extremaData_comparison2to1[1,"ymin"][[1]] & x <= extremaData_comparison2to1[1,"ymax"][[1]] &
# y >= extremaData_comparison2to1[2,"ymin"][[1]] & y <= extremaData_comparison2to1[2,"ymax"][[1]] &
# theta >= extremaData_comparison2to1[3,"ymin"][[1]] & theta <= extremaData_comparison2to1[3,"ymax"][[1]] &
# pairwiseCompCor >= extremaData_comparison2to1[4,"ymin"][[1]] & pairwiseCompCor <= extremaData_comparison2to1[4,"ymax"][[1]] ~ "Congruent",
# TRUE ~ "Not Congruent")) %>%
# pivot_longer(cols = c(x,y,theta,pairwiseCompCor),
# names_to = "parameter") %>%
# mutate(parameter = factor(parameter,c("x","y","theta","pairwiseCompCor")),
# Classification = factor(Classification,levels = c("Congruent","Not Congruent"))) %>%
# ggplot() +
# scale_colour_manual(values = c("#1b03a3","#a60b00")) +
# geom_line(aes(x = parameter,y = value,group = cellNum,colour = Classification),
# size = .1) +
# geom_tile(data = extremaData_comparison2to1,
# aes(x = parameter,
# y = ymed,
# width = .25,
# height = ymax - ymin),
# fill = "#7570b3",
# colour = "black",
# alpha = .4) +
# theme_bw() +
# theme(axis.text.y = element_blank(),
# axis.title.y = element_blank(),
# axis.title.x = element_blank(),
# axis.ticks = element_blank(),
# legend.position = "none",
# plot.margin = unit(c(.55,0,0,0), "cm")) +
# scale_x_discrete(labels = c(expression(paste(Delta, "x")),
# expression(paste(Delta, "y")),
# expression(theta),
# expression("CCF"[max])))
## ---- include=FALSE-----------------------------------------------------------
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-1` <- kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-1` +
# ggplot2::theme(plot.margin=unit(c(0,-.5,0,-.5), "cm"))
#
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-2` <- kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-2` +
# ggplot2::theme(plot.margin=unit(c(0,-.5,0,-.5), "cm"))
#
# knmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 2-1` <- knmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 2-1` +
# ggplot2::theme(plot.margin=unit(c(0,-.5,0,-.5), "cm"))
#
# knmCMCPlot_list_comparison2to1 <- cmcR::cmcPlot(fadul2.1_processed,
# fadul1.1_processed,
# reference_v_target_CMCs = knmComparison_allCMCs_rev,
# target_v_reference_CMCs = knmComparison_allCMCs,
# type = "list",
# x3pNames = c("Fadul 2-1","Fadul 1-1"),
# legend.quantiles = c(0,.01,.2,.5,.8,.99,1),
# cell.alpha = .15,
# na.value = "gray90")
#
# kmCMCPlot_list_comparison2to1 <- cmcR::cmcPlot(fadul1.2_processed,
# fadul1.1_processed,
# reference_v_target_CMCs = kmComparison_allCMCs_rev,
# target_v_reference_CMCs = kmComparison_allCMCs,
# x3pNames = c("Fadul 1-1","Fadul 1-2"),
# legend.quantiles = c(0,.01,.2,.5,.8,.99,1),
# cell.colors = c("black","black"),
# cell.alpha = .15,
# na.value = "gray90",
# type = "list")
#
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 1-1`$layers <- kmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 1-1`$layers[-3]
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 1-2`$layers <- kmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 1-2`$layers[-3]
# knmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 2-1`$layers <- knmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 2-1`$layers[-3]
#
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 1-1` <- kmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 1-1` +
# ggplot2::theme(legend.position = "none",
# plot.margin=unit(c(0,-.5,0,-.5), "cm"),
# plot.title = element_blank()) +
# coord_fixed(xlim = c(-400,3600), ylim = c(-100,3800)) +
# annotate(geom = "text",x = 3300/2,y = 3100/2,label = "Fadul 1-1",size = 4)
#
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 1-2` <- kmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 1-2`+
# ggplot2::theme(legend.position = "none",
# plot.margin=unit(c(0,-.5,0,-.5), "cm"),
# plot.title = element_blank()) +
# coord_fixed(xlim = c(-400,3600), ylim = c(-100,3800)) +
# annotate(geom = "text",x = 3300/2,y = 3100/2,label = "Fadul 1-2",size = 4)
#
# knmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 2-1` <- knmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 2-1` +
# ggplot2::theme(legend.position = "none",
# plot.margin=unit(c(0,-.5,0,-.5), "cm"),
# plot.title = element_blank()) +
# coord_fixed(xlim = c(-400,3600), ylim = c(-100,3800)) +
# annotate(geom = "text",x = 3300/2,y = 3100/2,label = "Fadul 2-1",size = 4)
## ----warning=TRUE,message=FALSE,echo=FALSE,fig.width = 7, fig.align = 'center'----
#
# reference_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 4.5,label = expression(paste(underline("Reference")))) +
# theme_void()
#
# target_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 4.5,label = expression(paste(underline("Target")))) +
# theme_void()
#
# originalMethod_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 4.5,label = expression(paste(underline("Original Method Classif.")))) +
# theme_void()
#
# originalCMC_count_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 4.5,label = expression(paste(underline("CMC Count")))) +
# theme_void()
#
# originalCMC_comparison1to2_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 4,label = "19 CMCs") +
# theme_void()
#
# originalCMC_comparison2to1_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 4,label = "18 CMCs") +
# theme_void()
# # Some internal call to is.na within grid.arrange is throwing a warning for the
# # pairwiseCompCor_label since it contains an expression. Since this isn't
# # anything wrong with vignette, we'll just suppress it
# suppressWarnings({
# plt <- gridExtra::arrangeGrob(reference_label,
# target_label,
# originalMethod_label,
# originalCMC_count_label,
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-1`,
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_reference_v_target$`Fadul 1-2`,
# originalMethod_comparison1to2_pcp,
# originalCMC_comparison1to2_label,
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 1-2`,
# kmCMCPlot_list_comparison1to2$originalMethodCMCs_target_v_reference$`Fadul 1-1`,
# originalMethod_comparison2to1_pcp,
# originalCMC_comparison2to1_label,
# blank_label,
# blank_label,
# pltLegend_horizontal,
# blank_label,
# heights = unit(c(2,9,9,2),units = "null"),
# widths = unit(c(2,2,2,1),"null")
# )
#
# # ggsave("derivatives/originalMethodPCP.png",plt)
# })
## ---- echo=FALSE,eval=TRUE,out.width=600,fig.align="center"-------------------
knitr::include_graphics("https://github.com/jzemmels/vignetteImages/blob/main/originalMethodPCP.png?raw=true")
## ----include=FALSE------------------------------------------------------------
# theta_rescaled <- kmComparisonFeatures %>%
# select(theta) %>%
# distinct() %>%
# mutate(thetaScaled = scales::rescale(theta))
#
# highCMC_medianData_comparison1to2 <- kmComparisonFeatures %>%
# filter(theta %in% c(-24,-27)) %>%
# group_by(theta) %>%
# summarise(x = median(x),
# y = median(y)) %>%
# ungroup() %>%
# mutate(pairwiseCompCor = c(.75,.75),
# cellNum = c(100,103))
#
# highCMC_yminData_comparison1to2 <- highCMC_medianData_comparison1to2 %>%
# mutate(x = x - 20,
# y = y - 20,
# pairwiseCompCor = c(.5,.5),
# cellNum = c(99,102))
#
# highCMC_ymaxData_comparison1to2 <- highCMC_medianData_comparison1to2 %>%
# mutate(x = x + 20,
# y = y + 20,
# pairwiseCompCor = c(1,1),
# cellNum = c(101,103))
#
# highCMC_congruentData_comparison1to2 <- kmComparisonFeatures %>%
# filter(theta %in% c(-24,-27)) %>%
# select(-c(cellIndex,fft_ccf)) %>%
# mutate(cellNum = 1:nrow(.)) %>%
# bind_rows(highCMC_yminData_comparison1to2,
# highCMC_medianData_comparison1to2,
# highCMC_ymaxData_comparison1to2) %>%
# select(-pairwiseCompCor) %>%
# pivot_longer(cols = c(x,y),
# names_to = "parameter") %>%
# group_by(parameter) %>%
# mutate(scaledValue = scales::rescale(value)) %>%
# bind_rows(kmComparisonFeatures %>%
# filter(theta %in% c(-24,-27)) %>%
# select(-c(cellIndex,fft_ccf)) %>%
# mutate(cellNum = 1:nrow(.)) %>%
# bind_rows(highCMC_yminData_comparison1to2,
# highCMC_medianData_comparison1to2,
# highCMC_ymaxData_comparison1to2) %>%
# select(-c(x,y)) %>%
# mutate(parameter = "pairwiseCompCor") %>%
# rename(value = pairwiseCompCor) %>%
# mutate(scaledValue = value)) %>%
# arrange(cellNum)
#
# highCMC_extremaData_comparison1to2 <- highCMC_congruentData_comparison1to2 %>%
# filter(cellNum > 90) %>%
# select(-c(cellNum,value)) %>%
# arrange(theta,parameter) %>%
# ungroup() %>%
# mutate(name = rep(c("ymin","ymed","ymax"),times = 6)) %>%
# pivot_wider(id_cols = c(parameter,theta,scaledValue),
# names_from = name,
# values_from = scaledValue)
#
# highCMC_comparison1to2_congruentCells <- highCMC_congruentData_comparison1to2 %>%
# filter(cellNum < 90) %>%
# left_join(highCMC_extremaData_comparison1to2,by = c("parameter","theta")) %>%
# mutate(Classification = ifelse(scaledValue >= ymin & scaledValue <= ymax,"Congruent","Not Congruent")) %>%
# group_by(cellNum,theta) %>%
# summarise(Classification = ifelse(all(Classification == "Congruent"),"Congruent","Not Congruent"))
## ---- include=FALSE-----------------------------------------------------------
# highCMC_medianData_comparison1to2_lowCMC <- kmComparisonFeatures %>%
# filter(theta %in% c(27,30)) %>%
# group_by(theta) %>%
# summarise(x = median(x),
# y = median(y)) %>%
# ungroup() %>%
# mutate(pairwiseCompCor = c(.75,.75),
# cellNum = c(100,103))
#
# highCMC_yminData_comparison1to2_lowCMC <- highCMC_medianData_comparison1to2_lowCMC %>%
# mutate(x = x - 20,
# y = y - 20,
# pairwiseCompCor = c(.5,.5),
# cellNum = c(99,102))
#
# highCMC_ymaxData_comparison1to2_lowCMC <- highCMC_medianData_comparison1to2_lowCMC %>%
# mutate(x = x + 20,
# y = y + 20,
# pairwiseCompCor = c(1,1),
# cellNum = c(101,103))
#
# highCMC_congruentData_comparison1to2_lowCMC <- kmComparisonFeatures %>%
# filter(theta %in% c(27,30)) %>%
# select(-c(cellIndex,fft_ccf)) %>%
# mutate(cellNum = 1:nrow(.)) %>%
# bind_rows(highCMC_yminData_comparison1to2_lowCMC,
# highCMC_medianData_comparison1to2_lowCMC,
# highCMC_ymaxData_comparison1to2_lowCMC) %>%
# select(-pairwiseCompCor) %>%
# pivot_longer(cols = c(x,y),
# names_to = "parameter") %>%
# group_by(parameter) %>%
# mutate(scaledValue = scales::rescale(value)) %>%
# bind_rows( kmComparisonFeatures %>%
# filter(theta %in% c(27,30)) %>%
# select(-c(cellIndex,fft_ccf)) %>%
# mutate(cellNum = 1:nrow(.)) %>%
# bind_rows(highCMC_yminData_comparison1to2_lowCMC,
# highCMC_medianData_comparison1to2_lowCMC,
# highCMC_ymaxData_comparison1to2_lowCMC) %>%
# select(-c(x,y)) %>%
# mutate(parameter = "pairwiseCompCor") %>%
# rename(value = pairwiseCompCor) %>%
# mutate(scaledValue = value)) %>%
# arrange(cellNum)
#
# highCMC_extremaData_comparison1to2_lowCMC <- highCMC_congruentData_comparison1to2_lowCMC %>%
# filter(cellNum > 90) %>%
# select(-c(cellNum,value)) %>%
# arrange(theta,parameter) %>%
# ungroup() %>%
# mutate(name = rep(c("ymin","ymed","ymax"),times = 6)) %>%
# pivot_wider(id_cols = c(parameter,theta,scaledValue),
# names_from = name,
# values_from = scaledValue)
#
# highCMC_comparison1to2_congruentCells_lowCMC <- highCMC_congruentData_comparison1to2_lowCMC %>%
# filter(cellNum < 90) %>%
# left_join(highCMC_extremaData_comparison1to2_lowCMC,by = c("parameter","theta")) %>%
# mutate(Classification = ifelse(scaledValue >= ymin & scaledValue <= ymax,"Congruent","Not Congruent"),
# theta = factor(theta,levels = c(27,30))) %>%
# group_by(cellNum,theta) %>%
# summarise(Classification = ifelse(all(Classification == "Congruent"),"Congruent","Not Congruent"))
## ---- include=FALSE-----------------------------------------------------------
# #For some reason the extrema aren't calculated correctly making the delta x
# #rectangle look longer than the delta y rectangle. I'm just going to fix it here
# highCMC_extremaData_comparison1to2 <- highCMC_extremaData_comparison1to2 %>%
# mutate(ymin = ifelse(parameter == "x",ymax - .297,ymin))
#
# highCMC_comparison1to2_thetaNeg24 <- highCMC_congruentData_comparison1to2 %>%
# filter(cellNum < 90 & theta == -24) %>%
# left_join(theta_rescaled,by = "theta") %>%
# pivot_wider(id_cols = c(cellNum,theta,parameter,thetaScaled),names_from = parameter,values_from = scaledValue) %>%
# pivot_longer(cols = c(x,y,pairwiseCompCor,thetaScaled),
# names_to = "parameter",
# values_to = "scaledValue") %>%
# left_join(highCMC_comparison1to2_congruentCells,by = c("cellNum","theta")) %>%
# mutate(group = paste0(cellNum,theta),
# parameter = factor(parameter,c("x","y","thetaScaled","pairwiseCompCor")),
# Classification = factor(Classification,levels = c("Congruent","Not Congruent")),
# theta = factor(theta,levels = c(-27,-24))) %>%
# filter(parameter != "thetaScaled") %>%
# ggplot() +
# scale_colour_manual(values = c("#1b03a3","#a60b00")) +
# geom_line(aes(x = parameter,
# y = scaledValue,
# group = group,
# colour = Classification
# # linetype = Classification,
# # colour = theta
# ),
# size = .1) +
# geom_tile(data = highCMC_extremaData_comparison1to2 %>%
# filter(theta == -24),
# aes(x = parameter,
# y = ymed,
# width = .25,
# height = ymax - ymin
# # ,fill = theta
# ),
# fill = "#7570b3",
# colour = "black",
# alpha = .4) +
# theme_bw() +
# theme(axis.text.y = element_blank(),
# axis.title.y = element_blank(),
# axis.title.x = element_blank(),
# axis.ticks = element_blank(),
# legend.position = "none",
# plot.margin = unit(c(.55,0,0,0), "cm")) +
# scale_x_discrete(labels = c(expression(paste(Delta, "x")),
# expression(paste(Delta, "y")),
# # expression(theta),
# expression("CCF"[max])))
#
# highCMC_comparison1to2_theta30 <- highCMC_congruentData_comparison1to2_lowCMC %>%
# filter(cellNum < 90 & theta == 30) %>%
# left_join(theta_rescaled,by = "theta") %>%
# pivot_wider(id_cols = c(cellNum,theta,parameter,thetaScaled),names_from = parameter,values_from = scaledValue) %>%
# pivot_longer(cols = c(x,y,pairwiseCompCor,thetaScaled),
# names_to = "parameter",
# values_to = "scaledValue") %>%
# mutate(theta = factor(theta,levels = c(27,30))) %>%
# left_join(highCMC_comparison1to2_congruentCells_lowCMC %>%
# mutate(theta = factor(theta,levels = c(27,30))),
# by = c("cellNum","theta")) %>%
# mutate(group = paste0(cellNum,theta),
# parameter = factor(parameter,c("x","y","thetaScaled","pairwiseCompCor")),
# Classification = factor(Classification,levels = c("Congruent","Not Congruent"))) %>%
# filter(parameter != "thetaScaled") %>%
# ggplot() +
# scale_colour_manual(values = c("#1b03a3","#a60b00")) +
# geom_line(aes(x = parameter,
# y = scaledValue,
# group = group,
# colour = Classification
# # linetype = Classification,
# # colour = theta
# ),
# size = .1) +
# geom_tile(data = highCMC_extremaData_comparison1to2_lowCMC %>%
# filter(theta == 30),
# aes(x = parameter,
# y = ymed,
# width = .25,
# height = ymax - ymin
# # ,fill = theta
# ),
# fill = "#7570b3",
# colour = "black",
# alpha = .4) +
# theme_bw() +
# theme(axis.text.y = element_blank(),
# axis.title.y = element_blank(),
# axis.title.x = element_blank(),
# axis.ticks = element_blank(),
# legend.position = "none",
# plot.margin = unit(c(.55,0,0,0), "cm")) +
# scale_x_discrete(labels = c(expression(paste(Delta, "x")),
# expression(paste(Delta, "y")),
# # expression(theta),
# expression("CCF"[max])))
## ----warning=TRUE,message=FALSE,echo=FALSE,fig.width = 7, fig.align = 'center'----
#
# highCMC_comparison1to2_cmcTheta <- bind_rows(kmComparisonFeatures %>%
# mutate(direction = "Fadul 1-1 vs. Fadul 1-2",
# cmcThetaDistribClassif = cmcR::decision_highCMC_cmcThetaDistrib(cellIndex,x,y,theta,pairwiseCompCor)) %>%
# cmcR::decision_highCMC_identifyHighCMCThetas(),
# kmComparisonFeatures_rev %>%
# mutate(direction = "Fadul 1-2 vs. Fadul 1-1",
# cmcThetaDistribClassif = cmcR::decision_highCMC_cmcThetaDistrib(cellIndex,x,y,theta,pairwiseCompCor)) %>%
# cmcR::decision_highCMC_identifyHighCMCThetas()) %>%
# filter(cmcThetaDistribClassif == "CMC Candidate" & direction == "Fadul 1-1 vs. Fadul 1-2") %>%
# ggplot(aes(x = theta,
# fill = thetaCMCIdentif)) +
# geom_bar(stat = "count",alpha = .7) +
# facet_wrap(~ direction,ncol = 1) +
# theme_bw() +
# coord_cartesian(xlim = c(-30,30),
# ylim = c(0,NA)) +
# ggplot2::scale_fill_manual(values = c("black","gray50")) +
# scale_x_continuous(expression(paste("Rotation angle ", theta)),
# breaks = seq(-30,30,by = 15),
# limits = c(-32,32)) +
# guides(fill = guide_legend(title = "High CMC Classif.")) +
# theme(legend.position = "bottom")
#
# thetaNeg24_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 4,label = expression(paste(theta," = -24"))) +
# theme_void()
#
# theta30_label <- ggplot() +
# annotate("text",x = 1,y = 1,size = 4,label = expression(paste(theta," = 30"))) +
# theme_void()
# # Some internal call to is.na within grid.arrange is throwing a warning for the
# # pairwiseCompCor_label since it contains an expression. Since this isn't
# # anything wrong with vignette, we'll just suppress it
# suppressWarnings({
# plt <- ggplot(data.frame(a = 1)) +
# theme_void() +
# coord_cartesian(xlim = c(1,30),
# ylim = c(1,30),
# expand = FALSE) +
# annotation_custom(ggplotGrob(highCMC_comparison1to2_cmcTheta),xmin = 6,xmax = 24,ymin = 1,ymax = 30) +
# annotation_custom(ggplotGrob(highCMC_comparison1to2_thetaNeg24),xmin = 1,xmax = 6,ymin = 4,ymax = 14) +
# annotation_custom(ggplotGrob(thetaNeg24_label),xmin = 1,xmax = 6,ymin = 10.5,ymax = 16) +
# annotation_custom(pltLegend_vertical_leftAligned,xmin = 2.5,xmax = 3,ymin = 2,ymax = 3) +
# annotation_custom(ggplotGrob(highCMC_comparison1to2_theta30),xmin = 24,xmax = 29,ymin = 4,ymax = 14) +
# annotation_custom(ggplotGrob(theta30_label),xmin = 24,xmax = 29,ymin = 10.5,ymax = 16) +
# annotation_custom(pltLegend_vertical_rightAligned,xmin = 27,xmax = 27.75,ymin = 2,ymax = 3) +
# geom_path(data = data.frame(x = c(6,10),y = c(9,9)),
# aes(x = x, y = y), size = 1, arrow = arrow(length = unit(.02, "npc"), type = "closed")) +
# geom_path(data = data.frame(x = c(23,24.1),y = c(9,9)),
# aes(x = x, y = y), size = 1, arrow = arrow(length = unit(.02, "npc"), type = "closed",ends = "first"))
#
# # ggsave("derivatives/highCMCDistribution.png",plt)
# })
## ----echo=FALSE,eval=TRUE,out.width=600,fig.align="center"--------------------
knitr::include_graphics("https://github.com/jzemmels/vignetteImages/blob/main/highCMCDistribution.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.