#Library

# Load necessary libraries
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(tidyr)
## Warning: package 'tidyr' was built under R version 4.3.2
library(ggplot2)

#Simulation Setup

#Creating Functions to Monitor the Funnel and Rarity Distributions

#Creating a Function to Open a Pack
open_pack <- function(all_cards, pack) {
  
  num_cards <- pack$Card_per_Pack
  guaranteed_card <- character(0)
  
  if(pack$Guaranteed_Rarity == "Common"){
    guaranteed_card <-  sample(all_cards[grepl("Common", all_cards)], 1)
    num_cards <- num_cards - 1
    
  }
  else if (pack$Guaranteed_Rarity == "Uncommon"){
    guaranteed_card <-  sample(all_cards[grepl("Uncommon", all_cards)], 1)
    num_cards <- num_cards - 1
  }
  else if (pack$Guaranteed_Rarity == "Rare"){
    guaranteed_card <- sample(all_cards[grepl("Rare", all_cards)], 1)
    num_cards <- num_cards - 1
    
  }
  else {guranteed_card <- character(0)}
  
  drawn_cards <- sample(all_cards, size = num_cards, replace = TRUE, prob = pack$Weights)
  
  return(c(guaranteed_card, drawn_cards))
}

#Function to Give a New Card for Pity
replace_with_new_card <- function(drawn_cards, received_cards, all_cards){
  #Find the Remaining New cards
  new_cards <- setdiff(all_cards, received_cards)
  
  
  if(length(new_cards) > 0){
    new_card <- sample(new_cards, 1)
    drawn_cards <- drawn_cards[-sample(length(drawn_cards), 1)]
    drawn_cards <- c(drawn_cards, new_card)
    return(drawn_cards)
  }
  else{
    return(drawn_cards) # this is the case when all cards have already been received
  }
}

#Function to Simulate a Day
simulate_day <- function(common_pack, uncommon_pack, rare_pack, day, daily_completion, common_completion, uncommon_completion, rare_completion, stagnation_counter, received_cards, all_cards, pity_counter){
  
  common_draws <- unlist(replicate(common_pack$Pack_per_Day, open_pack(all_cards, common_pack)))
  uncommon_draws <- unlist(replicate(uncommon_pack$Pack_per_Day, open_pack(all_cards, uncommon_pack)))
  rare_draws <- if(day %% rare_pack$Source_Rate == 0) unlist(replicate(rare_pack$Pack_per_Day, open_pack(all_cards, rare_pack))) else character(0)
  
  
  drawn_cards <- c(common_draws, uncommon_draws, rare_draws)
  temp_received_cards <- unique(c(received_cards, drawn_cards))
  
  #Calculate New Completion Percentage
  unique_cards_collected <- length(unique(temp_received_cards))
  completion_percentage <- unique_cards_collected / (length(all_cards)) * 100
  
  # Update stagnation counter
  if (day > 1 && completion_percentage == daily_completion[day - 1]) {
    stagnation_counter <- stagnation_counter + 1
  } else {
    stagnation_counter <- 0
  }
  
 # Apply pity system if stagnation_counter >= 4
  if (stagnation_counter >= pity_counter) {
    drawn_cards <- replace_with_new_card(drawn_cards, temp_received_cards, all_cards)
    temp_received_cards <- unique(c(received_cards, drawn_cards))
    #Recalculate
    unique_cards_collected <- length(unique(temp_received_cards))
    completion_percentage <- unique_cards_collected / (length(all_cards)) * 100
    stagnation_counter <- 0  # Reset the stagnation counter after giving a new card
  }
  
  received_cards <- temp_received_cards
  
  common_cards_received <- received_cards[grepl("Common", received_cards)]
  common_cards_completion <- length(unique(common_cards_received)) / (length(common_cards)) * 100
  common_completion[day] <- common_cards_completion
  
  uncommon_cards_received <- received_cards[grepl("Uncommon", received_cards)]
  uncommon_cards_completion <- length(unique(uncommon_cards_received)) / (length(uncommon_cards)) * 100
  uncommon_completion[day] <- uncommon_cards_completion
  
  rare_cards_received <- received_cards[grepl("Rare", received_cards)]
  rare_cards_completion <- length(unique(rare_cards_received)) / (length(rare_cards)) * 100
  rare_completion[day] <- rare_cards_completion
  
  
  daily_completion[day] <- completion_percentage
  
  return(list(drawn_cards = drawn_cards, received_cards = received_cards, daily_completion = daily_completion, stagnation_counter = stagnation_counter, common_completion = common_completion, uncommon_completion = uncommon_completion, rare_completion = rare_completion))
}

#Function to Simulate One Person
simulate_person <- function(common_pack, uncommon_pack, rare_pack, days, all_cards){
  
  collected_cards <- character()
  received_cards <- character()
  daily_completion <- numeric(days)
  
  common_completion <- numeric(days)
  uncommon_completion <- numeric(days)
  rare_completion <- numeric(days)
  
  stagnation_counter <- 0
  
  for (day in 1:days) {
    result <- simulate_day(common_pack, uncommon_pack, rare_pack, day, daily_completion, common_completion, uncommon_completion, rare_completion, stagnation_counter, received_cards, all_cards, pity_counter)
    collected_cards <- c(collected_cards, result$drawn_cards)
    received_cards <- result$received_cards
    daily_completion <- result$daily_completion
    
    common_completion <- result$common_completion
    uncommon_completion <- result$uncommon_completion
    rare_completion <- result$rare_completion
    
    stagnation_counter <- result$stagnation_counter
  }

  return(list(collected_cards = collected_cards, daily_completion = daily_completion, common_completion = common_completion, uncommon_completion = uncommon_completion, rare_completion = rare_completion))
}

  
simulate_persons <- function(persons, days, common_pack, uncommon_pack, rare_pack, all_cards) {
  results <- lapply(1:persons, function(x) simulate_person(common_pack, uncommon_pack, rare_pack, days, all_cards))
  
  # Collect daily completion percentages for all individuals
  daily_completion_df <- do.call(cbind, lapply(results, function(x) x$daily_completion))
  colnames(daily_completion_df) <- paste0("Person_", 1:persons)
  
  #Collect daily common completion percentages for all individuals
  daily_common_completion_df <- do.call(cbind, lapply(results, function(x) x$common_completion))
  colnames(daily_common_completion_df) <- paste0("Person_", 1:persons)
  
  #Collect daily uncommon completion percentages for all individuals
  daily_uncommon_completion_df <- do.call(cbind, lapply(results, function(x) x$uncommon_completion))
  colnames(daily_uncommon_completion_df) <- paste0("Person_", 1:persons)
  
  #Collect daily rare completion percentages for all individuals
  daily_rare_completion_df <- do.call(cbind, lapply(results, function(x) x$rare_completion))
  colnames(daily_rare_completion_df) <- paste0("Person_", 1:persons)
  
  # Collect all collected cards for each individual
  collected_cards_df <- do.call(cbind, lapply(results, function(x) x$collected_cards))
  colnames(collected_cards_df) <- paste0("Person_", 1:persons)
  
  return(list(collected_cards_df = as.data.frame(collected_cards_df), daily_completion_df = as.data.frame(daily_completion_df), daily_common_completion_df = as.data.frame(daily_common_completion_df), daily_uncommon_completion_df = as.data.frame(daily_uncommon_completion_df), daily_rare_completion_df = as.data.frame(daily_rare_completion_df)))
}

calculate_unique_values <- function(df) {
  unique_counts <- sapply(df, function(column) length(unique(column[!is.na(column)])))
  return(table(unique_counts))
}

#Rare by Source

counter <- 0

for(i in 1:1000){
  cardsDrawn <- open_pack(all_cards, rare_pack)
  rareCards <- cardsDrawn[grepl("Rare", cardsDrawn)]
  if(length(rareCards) == 0){counter <- counter + 1}
}

# Initialize vectors to store card draws for each rarity
total_common_draw_common_pack <- c()
total_uncommon_draw_common_pack <- c()
total_rare_draw_common_pack <- c()

total_common_draw_uncommon_pack <- c()
total_uncommon_draw_uncommon_pack <- c()
total_rare_draw_uncommon_pack <- c()

total_common_draw_rare_pack <- c()
total_uncommon_draw_rare_pack <- c()
total_rare_draw_rare_pack <- c()

# Simulate the draws
for (i in 1:1000) {
  common_draws <- unlist(replicate(common_pack$Pack_per_Day, open_pack(all_cards, common_pack)))
  uncommon_draws <- unlist(replicate(uncommon_pack$Pack_per_Day, open_pack(all_cards, uncommon_pack)))
  rare_draws <- unlist(replicate(rare_pack$Pack_per_Day, open_pack(all_cards, rare_pack)))
  
  # Filter cards by rarity from each pack type
  common_common_draw <- common_draws[grepl("Common", common_draws)]
  uncommon_common_draw <- common_draws[grepl("Uncommon", common_draws)]
  rare_common_draw <- common_draws[grepl("Rare", common_draws)]
  
  common_uncommon_draw <- uncommon_draws[grepl("Common", uncommon_draws)]
  uncommon_uncommon_draw <- uncommon_draws[grepl("Uncommon", uncommon_draws)]
  rare_uncommon_draw <- uncommon_draws[grepl("Rare", uncommon_draws)]
  
  common_rare_draw <- rare_draws[grepl("Common", rare_draws)]
  uncommon_rare_draw <- rare_draws[grepl("Uncommon", rare_draws)]
  rare_rare_draw <- rare_draws[grepl("Rare", rare_draws)]
  
  # Append to respective vectors
  total_common_draw_common_pack <- c(total_common_draw_common_pack, common_common_draw)
  total_uncommon_draw_common_pack <- c(total_uncommon_draw_common_pack, uncommon_common_draw)
  total_rare_draw_common_pack <- c(total_rare_draw_common_pack, rare_common_draw)
  
  total_common_draw_uncommon_pack <- c(total_common_draw_uncommon_pack, common_uncommon_draw)
  total_uncommon_draw_uncommon_pack <- c(total_uncommon_draw_uncommon_pack, uncommon_uncommon_draw)
  total_rare_draw_uncommon_pack <- c(total_rare_draw_uncommon_pack, rare_uncommon_draw)
  
  total_common_draw_rare_pack <- c(total_common_draw_rare_pack, common_rare_draw)
  total_uncommon_draw_rare_pack <- c(total_uncommon_draw_rare_pack, uncommon_rare_draw)
  total_rare_draw_rare_pack <- c(total_rare_draw_rare_pack, rare_rare_draw)
}

# Calculate the amount of cards drawn from each pack type
amount_common_common_pack <- length(total_common_draw_common_pack)
amount_uncommon_common_pack <- length(total_uncommon_draw_common_pack)
amount_rare_common_pack <- length(total_rare_draw_common_pack)

amount_common_uncommon_pack <- length(total_common_draw_uncommon_pack)
amount_uncommon_uncommon_pack <- length(total_uncommon_draw_uncommon_pack)
amount_rare_uncommon_pack <- length(total_rare_draw_uncommon_pack)

amount_common_rare_pack <- length(total_common_draw_rare_pack)
amount_uncommon_rare_pack <- length(total_uncommon_draw_rare_pack)
amount_rare_rare_pack <- length(total_rare_draw_rare_pack)

# Calculate the total number of cards drawn for each rarity
total_common_draws <- amount_common_common_pack + amount_common_uncommon_pack + amount_common_rare_pack
total_uncommon_draws <- amount_uncommon_common_pack + amount_uncommon_uncommon_pack + amount_uncommon_rare_pack
total_rare_draws <- amount_rare_common_pack + amount_rare_uncommon_pack + amount_rare_rare_pack

# Calculate the percentages
percent_common_common_pack <- (amount_common_common_pack / total_common_draws) * 100
percent_uncommon_common_pack <- (amount_uncommon_common_pack / total_uncommon_draws) * 100
percent_rare_common_pack <- (amount_rare_common_pack / total_rare_draws) * 100

percent_common_uncommon_pack <- (amount_common_uncommon_pack / total_common_draws) * 100
percent_uncommon_uncommon_pack <- (amount_uncommon_uncommon_pack / total_uncommon_draws) * 100
percent_rare_uncommon_pack <- (amount_rare_uncommon_pack / total_rare_draws) * 100

percent_common_rare_pack <- (amount_common_rare_pack / total_common_draws) * 100
percent_uncommon_rare_pack <- (amount_uncommon_rare_pack / total_uncommon_draws) * 100
percent_rare_rare_pack <- (amount_rare_rare_pack / total_rare_draws) * 100

# Create a data frame with the calculated percentages
rarity_sources_df <- data.frame(
  Rarity = c("Common", "Uncommon", "Rare"),
  Common_Pack = c(percent_common_common_pack, percent_uncommon_common_pack, percent_rare_common_pack),
  Uncommon_Pack = c(percent_common_uncommon_pack, percent_uncommon_uncommon_pack, percent_rare_uncommon_pack),
  Rare_Pack = c(percent_common_rare_pack, percent_uncommon_rare_pack, percent_rare_rare_pack)
)

# Print the final data frame
print(rarity_sources_df)
##     Rarity Common_Pack Uncommon_Pack Rare_Pack
## 1   Common    55.70808      32.10547  12.18645
## 2 Uncommon    36.27772      45.12904  18.59324
## 3     Rare    15.30354      11.21417  73.48229
rarity_sources_long_df <- rarity_sources_df %>%
  pivot_longer(cols = -Rarity, names_to = "Pack_Source", values_to = "Percentage")

# Plot the results with stacked bars
ggplot(rarity_sources_long_df, aes(x = Rarity, y = Percentage, fill = Pack_Source)) +
  geom_bar(stat = "identity", position = "stack") +
  labs(title = "Percentage of Cards by Rarity and Pack Source",
       x = "Rarity",
       y = "Percentage",
       fill = "Pack Source") +
  scale_fill_manual(values = c("Common_Pack" = "skyblue", "Uncommon_Pack" = "lightgreen", "Rare_Pack" = "pink")) +
  theme_minimal()

#Executing Functions to Get the Funnel

days <- 50
persons <- 10000
simulation_results_list <- simulate_persons(persons, days, common_pack, uncommon_pack, rare_pack, all_cards)
collected_cards_df <- simulation_results_list$collected_cards_df

daily_completion_df <- simulation_results_list$daily_completion_df
daily_common_completion_df <- simulation_results_list$daily_common_completion_df
daily_uncommon_completion_df <- simulation_results_list$daily_uncommon_completion_df
daily_rare_completion_df <- simulation_results_list$daily_rare_completion_df


unique_counts <- calculate_unique_values(collected_cards_df)
unique_counts <- as.data.frame(unique_counts)


# Calculate the total number of individuals
total_individuals <- sum(unique_counts$Freq)

# Calculate the percentages
unique_counts <- unique_counts %>%
  mutate(Percentage = (Freq / total_individuals) * 100)

# Plot the histogram
ggplot(unique_counts, aes(x = unique_counts , y = Percentage)) +
  geom_bar(stat = "identity", fill = "skyblue", color = "black") +
  labs(title = "Histogram of Unique Cards Collected",
       x = "Number of Unique Cards",
       y = "Percentage of Individuals") +
  theme_minimal()

#Calculating Unique Counts of Cards by Rarity

# Calculate total unique counts for each person
total_unique_counts <- sapply(collected_cards_df, function(column) length(unique(column[!is.na(column)])))

# Filter users who did not collect all 185 cards
filtered_collected_cards_df <- collected_cards_df[, total_unique_counts < 185]


calculate_card_type_counts <- function(df, card_type) {
  sapply(df, function(column) {
    unique_cards <- unique(column[!is.na(column)])
    sum(grepl(card_type, unique_cards))
  })
}

# Calculate unique counts for each card type
common_counts <- calculate_card_type_counts(filtered_collected_cards_df, "Common")
common_percent <- table(common_counts) / length(common_counts) * 100

uncommon_counts <- calculate_card_type_counts(filtered_collected_cards_df, "Uncommon")
uncommon_percent <- table(uncommon_counts)  / length(uncommon_counts) * 100

rare_counts <- calculate_card_type_counts(filtered_collected_cards_df, "Rare")
rare_percent<- table(rare_counts) / length(rare_counts) * 100



#Convert Tables to Data Frames
# Convert tables to data frames
common_percent_df <- as.data.frame(common_percent)
colnames(common_percent_df) <- c("Count", "Common_Percent")

uncommon_percent_df <- as.data.frame(uncommon_percent)
colnames(uncommon_percent_df) <- c("Count", "Uncommon_Percent")

rare_percent_df <- as.data.frame(rare_percent)
colnames(rare_percent_df) <- c("Count", "Rare_Percent")

# Calculate cards missing for each card type
common_missing <- length(common_cards) - common_counts
uncommon_missing <- length(uncommon_cards) - uncommon_counts
rare_missing <- length(rare_cards) - rare_counts

# Combine results into a data frame
card_type_missing_df <- data.frame(
  Common = common_missing,
  Uncommon = uncommon_missing,
  Rare = rare_missing
)

avg_common_missing <- mean(card_type_missing_df$Common)
avg_uncommon_missing <- mean(card_type_missing_df$Uncommon)
avg_rare_missing <- mean(card_type_missing_df$Rare)

avg_missing_df <- data.frame(avg_common_missing, avg_uncommon_missing, avg_rare_missing)
colnames(avg_missing_df) <- c("Common", "Uncommon", "Rare")
avg_missing_df
##      Common  Uncommon     Rare
## 1 0.5845527 0.9430393 1.995297
# Calculate the counts for each combination of rarity and cards missing
missing_summary <- data.frame(
  Rarity = rep(c("Common", "Uncommon", "Rare"), each = 6),
  Cards_Missing = rep(5:0, 3),
  Count = 0
)
# Fill in the counts for the table
for (i in 0:5) {
  missing_summary$Count[missing_summary$Rarity == "Common" & missing_summary$Cards_Missing == i] <- sum(common_missing == i)
  missing_summary$Count[missing_summary$Rarity == "Uncommon" & missing_summary$Cards_Missing == i] <- sum(uncommon_missing == i)
  missing_summary$Count[missing_summary$Rarity == "Rare" & missing_summary$Cards_Missing == i] <- sum(rare_missing == i)
}

# Calculate percentages
missing_summary$Percentage <- missing_summary$Count / persons * 100

# Print the final table
print(missing_summary)
##      Rarity Cards_Missing Count Percentage
## 1    Common             5     2       0.02
## 2    Common             4    24       0.24
## 3    Common             3   155       1.55
## 4    Common             2   909       9.09
## 5    Common             1  3198      31.98
## 6    Common             0  5279      52.79
## 7  Uncommon             5    13       0.13
## 8  Uncommon             4   121       1.21
## 9  Uncommon             3   490       4.90
## 10 Uncommon             2  1618      16.18
## 11 Uncommon             1  3744      37.44
## 12 Uncommon             0  3578      35.78
## 13     Rare             5   277       2.77
## 14     Rare             4   797       7.97
## 15     Rare             3  1844      18.44
## 16     Rare             2  2836      28.36
## 17     Rare             1  2748      27.48
## 18     Rare             0   976       9.76
# Plot the results
ggplot(missing_summary, aes(x = Cards_Missing, y = Percentage, fill = Rarity)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Percentage of Users by Cards Missing and Rarity",
       x = "Number of Cards Missing",
       y = "Percentage of Users",
       fill = "Rarity") +
  scale_fill_manual(values = c("Common" = "skyblue", "Uncommon" = "lightgreen", "Rare" = "pink")) +
  theme_minimal()

#Progression Percentages

average_daily_completion <- rowMeans(daily_completion_df, na.rm = TRUE)
average_daily_common_completion <- rowMeans(daily_common_completion_df, na.rm = TRUE)
average_daily_uncommon_completion <- rowMeans(daily_uncommon_completion_df, na.rm = TRUE)
average_daily_rare_completion <- rowMeans(daily_rare_completion_df, na.rm = TRUE)

# Combine the average_daily_completion into a single data frame
plot_data <- data.frame(
  Day = 1:length(average_daily_completion),
  Average_Completion = average_daily_completion
)

# Plot the data
ggplot(plot_data, aes(x = Day, y = Average_Completion)) +
  geom_line(color = "blue") +
  geom_point(color = "red") +
  labs(title = "Album Progression",
       x = "Day",
       y = "Average Completion (%)") +
  theme_minimal()

#Stagnation Matrix

# Function to identify stagnant periods
identify_stagnant_periods <- function(completion_vector) {
  stagnant_counts <- rep(0, length(completion_vector))
  for (i in 2:length(completion_vector)) {
    if (completion_vector[i] == 100) {
      stagnant_counts[i] <- stagnant_counts[i - 1]  # Maintain the previous count if already complete
    } else if (completion_vector[i] == completion_vector[i - 1]) {
      stagnant_counts[i] <- stagnant_counts[i - 1] + 1
    }
  }
  return(stagnant_counts)
}

# Apply the function to identify stagnant periods for each individual
stagnant_matrix <- apply(daily_completion_df, 2, identify_stagnant_periods)

# Convert to a data frame
stagnant_df <- as.data.frame(stagnant_matrix)

# Find the longest stagnant period for each individual
longest_stagnant <- apply(stagnant_df, 2, max, na.rm = TRUE)

# Create a frequency table for the longest stagnant periods
stagnant_summary <- table(longest_stagnant)

# Convert the table to a data frame
stagnant_summary_df <- as.data.frame(stagnant_summary)
colnames(stagnant_summary_df) <- c("Stagnant_Period_Length", "Count")

# Sort the data frame in descending order of Stagnant_Period_Length
stagnant_summary_df <- stagnant_summary_df %>%
  arrange(desc(Stagnant_Period_Length))

# Calculate cumulative counts
stagnant_summary_df <- stagnant_summary_df %>%
  mutate(Cumulative_Count = cumsum(Count))

# Rearrange the data frame back in ascending order
stagnant_summary_df <- stagnant_summary_df %>%
  arrange(Stagnant_Period_Length)

# Print the final table
print(stagnant_summary_df)
##   Stagnant_Period_Length Count Cumulative_Count
## 1                      1    15            10000
## 2                      2   730             9985
## 3                      3  2158             9255
## 4                      4  7097             7097
# Plot the histogram
ggplot(stagnant_summary_df, aes(x = Stagnant_Period_Length , y = Count)) +
  geom_bar(stat = "identity", fill = "skyblue", color = "black") +
  labs(title = "Longest Stagnant Period",
       x = "Stagnant Period",
       y = "Count of Users") +
  theme_minimal()

#Plot Graph of Individuals with Long Stagnant Periods

# Identify individuals with an 18-day stagnant period
individuals_with_18_stagnant <- which(longest_stagnant == 4)

# Extract their daily completion data
completion_18_stagnant_df <- daily_completion_df[, individuals_with_18_stagnant, drop = FALSE]

# Extract the last 20 days of data
completion_18_stagnant_df_last_20_days <- tail(completion_18_stagnant_df, 20)

# Convert to long format for ggplot2
completion_18_stagnant_long <- completion_18_stagnant_df_last_20_days %>%
  mutate(Day = 1:nrow(completion_18_stagnant_df_last_20_days)) %>%
  pivot_longer(cols = -Day, names_to = "Individual", values_to = "Completion")

# Plot the progression curves for the last 20 days
ggplot(completion_18_stagnant_long, aes(x = Day, y = Completion, color = Individual)) +
  geom_line() +
  labs(title = "Progression Curves for Individuals with an 18-Day Stagnant Period (Last 20 Days)",
       x = "Day",
       y = "Completion Percentage") +
  theme_minimal() +
  theme(legend.position = "none")  # Hide the legend for clarity