A Note on the Dirichlet Distribution

# This function generates the data frame for the animation
generate_dirichlet_animation_data <- function(alpha1_values, alpha2_values, alpha3_values, n_samples = 2000) {
  library(MCMCpack)
  
  # Triangle vertices
  v1 <- c(1, 0)
  v2 <- c(0, 1)
  v3 <- c(0, 0)
  
  # Projection function
  project_to_triangle <- function(x1, x2, x3) {
    x <- x1 * v1[1] + x2 * v2[1] + x3 * v3[1]
    y <- x1 * v1[2] + x2 * v2[2] + x3 * v3[2]
    data.frame(x = x, y = y)
  }
  
  # Generate animation data
  animation_data <- do.call(rbind, lapply(seq_along(alpha1_values), function(i) {
    alpha <- c(alpha1_values[i], alpha2_values[i], alpha3_values[i])
    samples <- rdirichlet(n_samples, alpha)
    projected <- project_to_triangle(samples[,1], samples[,2], samples[,3])
    projected$alpha1 <- alpha[1]
    projected$alpha2 <- alpha[2]
    projected$alpha3 <- alpha[3]
    projected$frame <- i
    projected
  }))
  
  return(animation_data)
}

# This function creates the animated plot
plot_dirichlet_evolution <- function(animation_data) {
  library(ggplot2)
  library(gganimate)
  library(grid)  # for arrow units
  
  # Triangle vertices
  v1 <- c(1, 0)
  v2 <- c(0, 1)
  v3 <- c(0, 0)
  
  # Label positions
  label_df <- data.frame(
    x = c(v1[1], v2[1], v3[1]),
    y = c(v1[2], v2[2], v3[2]),
    label = c("(1,0,0)", "(0,1,0)", "(0,0,1)"),
    nudge_x = c(-0.08, 0.1, 0),
    nudge_y = c(0, 0, 0.08)
  )
  
  # Triangle outline
  triangle_df <- data.frame(
    x = c(v1[1], v2[1], v3[1], v1[1]),
    y = c(v1[2], v2[2], v3[2], v1[2])
  )
  
  # Build plot
  p_animation <- ggplot(animation_data, aes(x = x, y = y)) +
    geom_point(alpha = 0.3, size = 0.8, color = "steelblue") +
    geom_density_2d(color = "red", alpha = 0.7) +
    geom_path(data = triangle_df, aes(x = x, y = y), color = "black", size = 1) +
    annotate("segment", x = 1, y = 0, xend = 0, yend = 1,
             arrow = arrow(length = unit(0.2, "cm")),
             color = "darkgreen", size = 1.2) +
    xlim(0, 1) + ylim(0, 1) +
    geom_text(data = label_df,
              aes(x = x, y = y, label = label),
              nudge_x = label_df$nudge_x,
              nudge_y = label_df$nudge_y,
              size = 4, fontface = "bold", color = "black") +
    labs(
      title = "Dirichlet Prior Evolution",
      subtitle = "",
      x = "Projected X",
      y = "Projected Y",
      caption = "Transition from uniform to concentrated distribution"
    ) +
    theme_minimal() +
    theme(
      plot.title = element_text(size = 16, hjust = 0.5),
      plot.subtitle = element_text(size = 14, hjust = 0.5),
      axis.title = element_text(size = 12),
      plot.caption = element_text(size = 10, hjust = 0.5)
    ) +
    transition_states(frame,
                      transition_length = 1,
                      state_length = 2) +
    ease_aes('sine-in-out')
  
  return(p_animation)
}

#| message: false
#| warning: false
#| code-fold: true
#| code-summary: "Animation Code"
#| 
set.seed(42)

# Parameters
alpha1_values <- seq(1, 0.1, by = -0.01)  # starts high, ends low
alpha2_values <- seq(1, 0.1, by = -0.01)   # starts low, ends high
alpha3_values <- seq(1, 0.1, by = -0.01)   # starts low, ends high

animation_data <- generate_dirichlet_animation_data(alpha1 = alpha1_values, 
                                                    alpha2 = alpha2_values, 
                                                    alpha3 = alpha3_values, 
                                                    n_samples = 2000)

plot_dirichlet_evolution(animation_data)