ggtda_experiments.Rmd

title: "R Notebook"
output: html_notebook

This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

Try executing this chunk by clicking the Run button within the chunk or by placing your cursor inside it and pressing Cmd+Shift+Enter.

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Cmd+Option+I.

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Cmd+Shift+K to preview the HTML file).

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.

library(ggplot2)
# attach *ggtda*
library(ggtda)

# generate the point cloud data
n <- 36; sd <- .2
set.seed(0)
first_column <- c(1.0, 2.0, 1.0, 2.0)
second_column <- c(1.0, 1.0, 2.0, 2.0)
d <- data.frame(
  first_column,
  second_column
)
# compute the persistent homology
ph <- as.data.frame(ripserr::vietoris_rips(as.matrix(d), dim = 1))
print(head(ph, n = 12))
ph <- transform(ph, dim = as.factor(dimension))

# fix a proximity for a Vietoris complex
prox <- 1.5

# visualize disks of fixed radii
# Use option theme_void() to get rid of all axis labels
# https://stackoverflow.com/questions/35090883/remove-all-of-x-axis-labels-in-ggplot
p_d <- ggplot(d, aes(x = first_column, y = second_column)) +
  theme_bw() +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank()) +
  theme(axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank()) +
  coord_fixed() +
  stat_disk(radius = prox/2, fill = "aquamarine3") +
  geom_point()
# Save plot as pdf
ggsave("diamonds3.pdf")

#  visualize the Vietoris complex for this proximity
p_sc <- ggplot(d, aes(x = first_column, y = second_column)) +
  theme_bw() +
  coord_fixed() +
  stat_vietoris2(diameter = prox, fill = "darkgoldenrod") +
  stat_vietoris1(diameter = prox, alpha = .25) +
  stat_vietoris0()
# combine the plots
gridExtra::grid.arrange(
  p_d, p_sc,
  layout_matrix = matrix(c(1, 2), nrow = 1)
)

# visualize the persistence data, indicating cutoffs at this proximity
p_bc <- ggplot(ph,
       aes(start = birth, end = death, colour = dim)) +
  theme_barcode() +
  geom_barcode() +
  labs(x = "Diameter", y = "Homological features") +
  geom_vline(xintercept = prox, color = "darkgoldenrod", linetype = "dashed")
p_pd <- ggplot(ph) +
  theme_persist() +
  coord_fixed() +
  stat_persistence(aes(start = birth, end = death, colour = dim, shape = dim)) +
  geom_abline(intercept = 0, slope = 1, color = "darkgray") +
  labs(x = "Birth", y = "Death") +
  lims(x = c(0, 0.8), y = c(0, NA)) +
  geom_point(data = data.frame(x = prox), aes(x, x),
             colour = "darkgoldenrod", shape = "diamond", size = 4)
# combine the plots
gridExtra::grid.arrange(
  p_bc, p_pd,
  layout_matrix = matrix(c(1, 2), nrow = 1)
)