simulator.Rmd

---
title: "Warewolf Simulation"
author: "Joey Stanley"
date: "4/28/2019"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

# Intro

This is a simulation of the Warewolf game. I was talking to Kyle for a while on Thursday, April 25, 2019 and I had the epiphany that I can make a Werewolf Game in Shiny now. That'll combine my R skills with the ability to run it from my phone. It's a very different set of R skills, but it might be possible. 


```{r, message = FALSE}
library(tidyverse)
library(glue)   # Easy printing
library(crayon) # Printing messages in color
```

## Purpose and Goal

There are two, possibly three purposes for this:

* Make a Shiny app that will simulate Werewolf Games using whatever parameters I want. This will be helpful for determining how strong various powers are, setting the balance of the game (werewolf-to-townspeople ratio), and just for fun.

* Make a Shiny app that will serve as a narrator's tool to help keep track of stuff and work out the logic. 

* Make a Shiny app that will serve as a platform-independent tool that everyone can log into and use simultaneously. This last one may not be possible because I think Shiny instances are all independent, but it might be plausible to constantly write and read in log files. It would take some work.

This script will serve as a sandbox to help me work out the R stuff. Once I'm done here I'll transfer it over to the Shiny app.

## Progress

*These roles are already incorporated into the program*
* Werewolves
* Angel
  + Saves others
* Witch
  + Save (5/5/19)
  + Kill (5/7/19)
* Dungeon Master (5/8/19)
  + Puts others in Dunegeon 
* Priest (5/9/19)
  + Puts other in Sanctuary 
  + Sanctuary protects from being voted off
  
## To do

*Roles that add to the logic*
* Apothecary---easy potions
  + water, save, kill, wine
* Angel
  + always saves self
* Town Drunk
* Extra Werewolf Kills
  + Alpha Wolf
  + Big Bad Wolf
  + Werewolf Cub
* Independent Werewolf Kills
  + Lone Wolf

*These have little effects on the logic*
* Detective
* Jester
* Apothecary---novelty potions
  + amnesiac, truth serum
* Additional Werewolves
  + Vegetarian Wolf
  + Traitor

*Chain reaction roles*---These will be difficult to implement because I'd have to add a *lot* of additional code. The Giant and Hunter will be easier, but adding the Lovers will be very difficult. 
* Giant
* Hunter
* Cupid
* Apathetic Lover
* Apothecary---difficult potions
  + love potion, with Apothecary as apathetic lover

*Switching Roles*---These will be especially difficult to implement. I have no idea how I'll do it to be honest.
* Silversmith
* Grave Robber
* Apprentice
* Additional Werewolves
  + Lycanthrope
  
*Other small details*---These are optional rules that don't need to be added. They probably have a very small odds on an overall game, but make for fun little Easter egg rules. 
* Dungeon Master
  + Themselves always in Dungeon
  + People in dungeon are immune from Hunter, Town Drunk, and Giant
* Priest
  + People in sanctuary are immune from Hunter, Town Drunk, and Giant



# Game setup

Eventually, I'll make this dynamic, but for now I'll hard-code it in.

## Assign the roles

Initially, I intended to make it so that each player had their own role. Critical information like their role and whether they're still in the game or not, would be there, but everything else (like the nighttime and daytime events and stuff) would be nested in a separate dataframe---one that had one row per day/night. But, it got too complicated to deal with the nested dataframe so I ditched it. However, I like the format, so I create the dataframe temporarily but then unnest it. The resulting `game` dataframe has one row per combination of player and round.

```{r}
pad_with_townspeople <- function(..., end_length) {
  roles <- unlist(list(...))
  n_townspeople <- end_length - length(roles)
  unlist(c(roles, rep("townsperson", n_townspeople)))
}
pad_with_townspeople(c("werewolf", "werewolf"), "angel", end_length = 5)
```


```{r}
new_game <- function(n_players = 12, n_werewolves = 4, other_roles = "default") {
  n_nights <- n_players
  
  non_essential_roles <- c("angel", "witch", "priest", "dungeon master")
  
  if (missing(other_roles) || other_roles == "default") {
    # If there are fewer players than there are roles, randomly choose some and don't use townspeople.
    if (n_players < (length(non_essential_roles) + n_werewolves)) {
      n_nonessential_roles_needed <- n_players - n_werewolves
      list_of_roles <- c(rep("werewolf", n_werewolves), 
                         sample(non_essential_roles, n_nonessential_roles_needed))
      # If there are ots of players, use all non_essential roles, plus townspeople.
    } else {
      list_of_roles <- pad_with_townspeople(rep("werewolf", n_werewolves), 
                                            non_essential_roles,
                                            end_length = n_players)
    }
    
    
  } else if (length(other_roles) == 1 && other_roles == "none") {
    list_of_roles <- pad_with_townspeople(rep("werewolf", n_werewolves),
                                          end_length = n_players)
  } else {
    list_of_roles <- pad_with_townspeople(rep("werewolf", n_werewolves),
                                          other_roles, 
                                          end_length = n_players)
  }
  
  players_and_roles <- tibble(player_id = 1:n_players,
                              role = sample(list_of_roles, replace = FALSE))
  
  expand.grid(round_num = 1:n_nights, player_id = 1:n_players) %>%
    mutate(is_alive = TRUE,
           when_died = NA,
           cause_of_death = NA,

           is_werewolf_victim = FALSE,
           is_angel_target    = FALSE,
           is_witch_save      = FALSE,
           is_witch_kill      = FALSE,
           
           is_dungmast_target = FALSE,
           is_in_dungeon      = FALSE,
           is_priest_target   = FALSE,
           is_in_sanctuary     = FALSE,
           
           is_voted_off       = FALSE) %>%
    left_join(players_and_roles, by = "player_id") %>%
    select(player_id, role, round_num, is_alive, when_died, cause_of_death, everything())
}
new_game() %>% select(player_id, role) %>% distinct() %>% arrange(role) %>% pull(role)
game <- new_game()
game <- new_game(other_roles = "none")
game <- new_game(other_roles = "angel")
game <- new_game(other_roles = rep("angel", 4), n_werewolves = 3)
```

## General getter functions

For simplicity (maybe?) I'll create this little helper function that extracts just one player from the above data frame.

```{r}
get_one_player <- function(game, id) { 
  game %>%
    filter(player_id == id)
}
```

And here's a helper function to extract just one of those nights.

```{r}
get_round <- function(game, this_round_num) {
  game %>%
    filter(round_num == this_round_num)
}
```

A generalized function to quickly count how many living players have a particular role. Useful for when determining whether something should happen at night.

```{r}
get_n_role <- function(game, this_round_num, r) {
  game %>%
    filter(round_num == this_round_num,
           role == r,
           is.na(cause_of_death)) %>%
    nrow()
}
```

A function to look up what player has a particular role. Works well for identifying self.

```{r}
get_player_id_from_role <- function(game, r) {
  this_person <- game %>% 
    filter(round_num == 1,
           role == r)
  
  if (nrow(this_person) > 1) {
    message(paste0("There are multiple people with the role", r, "and I don't know what to do!"))
    crash
  } else if (nrow(this_person) == 1) {
    return(this_person$player_id)
  } else {
    return(NA)
  }
}
```

```{r}
get_role_from_player_id <- function(game, p) {
  this_person <- game %>% 
    filter(round_num == 1,
           player_id == p)
  
  if (nrow(this_person) > 1) {
    message(paste0("There are multiple rows with the player ID", p, "and I don't know what to do!"))
    crash
  } else if (nrow(this_person) == 1) {
    return(this_person$role)
  } else {
    return(NA)
  }
}
```



# Night time phase

## Functions for nighttime roles

I've got to create separate functions for each role. For now I'll keep it simple.




The werewolves attack a random player each night.

```{r}
werewolf_attack_id <- function(game, this_round_num) {
  
  available_victims <- game %>%
    filter(round_num == this_round_num,
           is.na(cause_of_death), 
           role != "werewolf") %>%
    pull(player_id)
  
  n_victims <- 1
  sample(available_victims, n_victims)
}
werewolf_attack_id(game, 1)
```


The Angel saves a random player each night. In the future, I might make it so that they themselves are always saved.

```{r}
angel_save_id <- function(game, this_round_num) {
  available_targets <- game %>%
    filter(round_num == this_round_num,
           is.na(cause_of_death)) %>%
    pull(player_id)
  
  n_targets <- 1
  sample(available_targets, n_targets)
}
angel_save_id(game, 1)
```

The Witch gets a chance to save someone if they haven't done so already. Odds are 1 in 3 that they actually decide to use their power. They 

```{r}
witch_save_id <- function(game, this_round_num) {

  # If the witch has already saved someone skip this.
  witch_has_saved <- nrow(filter(game, is_witch_save == TRUE)) > 0
  if (witch_has_saved == TRUE) {
    return(NA)
  }
  
  # Look for the available targts.
  available_targets <- game %>%
    filter(round_num == this_round_num,
           is.na(cause_of_death),

           # Only werewolf victims, but only if the Angel hasn't already saved them.
           is_werewolf_victim == TRUE,
           is_angel_target == FALSE) %>%
    pull(player_id)
  
  # This might fix a bug.
  if (length(available_targets) == 0) {
    return(NA)
  }
  
  # Always save themselves.
  self_id <- get_player_id_from_role(game, "witch")
  if (self_id %in% available_targets) {
    return(self_id)
    
    
    # This is the person they'll save if it's determined they will save someone.
  } else {
    potential_saved_person <- available_targets
    # Down the road, make it a random sample, but be careful: it'll do weird things when there's just one sample(available_targets, 1)
  }
  
  # Don't autmatically save someone else: make it a 1 in 3 shot.
  if (sample(3, 1) == 1) {
    return(potential_saved_person)
  }
  
  # If we've made it here, that means the Witch won't save anyone.
  return(NA)
}
```

Witch will kill someone 1 in 3 times. It's theoretically possible to kill themselves. 

```{r}
witch_kill_id <- function(game, this_round_num) {

  # If the witch has already killed someone skip this.
  witch_has_killed <- nrow(filter(game, is_witch_kill == TRUE)) > 0
  if (witch_has_killed == TRUE) {
    return(NA)
  }
  
  # Don't autmatically kill the first round: make it a 1 in 3 shot.
  if (sample(3, 1) != 1) {
    return(NA)
  }
  
  # If we've made it here, that means the Witch will kill someone.
  
  # Look for the available targts (anyone but themselves)
  available_targets <- game %>%
    filter(round_num == this_round_num,
           is.na(cause_of_death)) %>%
    pull(player_id)

  # Use this syntax because the result might have a length of zero.
  if (length(available_targets) > 0) {
    n_targets <- 1
    return(sample(available_targets, n_targets))
  } else {
    return(NA)
  }
}
```


The Dungeon Master puts a random player in the dungeon each night. In the future, I might make it so that they themselves are always in the Dungeon.

```{r}
dungmast_target_id <- function(game, this_round_num) {
  available_targets <- game %>%
    filter(round_num == this_round_num,
           is.na(cause_of_death)) %>%
    pull(player_id)
  
  n_targets <- 1
  sample(available_targets, n_targets)
}
dungmast_target_id(game, 1)
```

```{r}
priest_target_id <- function(game, this_round_num) {
  available_targets <- game %>%
    filter(round_num == this_round_num,
           is.na(cause_of_death)) %>%
    pull(player_id)
  
  n_targets <- 1
  sample(available_targets, n_targets)
}
priest_target_id(game, 1)
```




# Apply nighttime logic

So, each of the roles have done their thing and all that data is stored in the `nighttime_events` object. However, this isn't linked to the players' data at all. Looks like I can't modify global variables from within a function so I'll have to do it separately.

## Assign properties

Here are the functions that'll simply change one cell in the `game` data frame. 

```{r}
make_werewolf_victim <- function(game, this_round_num) {
  game[game$player_id == werewolf_attack_id(game, this_round_num) & 
         game$round_num == this_round_num,"is_werewolf_victim"] <- TRUE
  game
}
make_werewolf_victim(game, 1)
```

```{r}
make_angel_save <- function(game, this_round_num) {
  
  # First get the number of angels remaining in the game
  n_angels <- get_n_role(game, this_round_num, "angel")
    
    # If there is more than zero
    if (n_angels > 0) {
      game[game$player_id == angel_save_id(game, this_round_num) & 
             game$round_num == this_round_num,"is_angel_target"] <- TRUE
    }
  game
}
make_angel_save(game, 1)
```

```{r}
make_witch_save <- function(game, this_round_num) {
  
  # First get the number of angels remaining in the game
  n_witches <- get_n_role(game, this_round_num, "witch")
  
  # Check if there is one first, because it might be NA.
  witch_save <- witch_save_id(game, this_round_num)
  
  # If there is more than zero
  if (n_witches > 0 && !is.na(witch_save)) {
    
    game[game$player_id == witch_save & 
           game$round_num == this_round_num,"is_witch_save"] <- TRUE
  }
  game
}
make_witch_save(game, 1)
```

```{r}
make_witch_kill <- function(game, this_round_num) {
  
  # First get the number of angels remaining in the game
  n_witches <- get_n_role(game, this_round_num, "witch")
  
  # Check if there is one first, because it might be NA.
  witch_kill <- witch_kill_id(game, this_round_num)
  
  # If there is more than zero
  if (n_witches > 0 && !is.na(witch_kill)) {
    
    game[game$player_id == witch_kill & 
           game$round_num == this_round_num,"is_witch_kill"] <- TRUE
  }
  game
}
make_witch_kill(game, 1)
```

```{r}
put_in_dungeon <- function(game, this_round_num) {
  
  # First get the number of angels remaining in the game
  n_dungmasts <- get_n_role(game, this_round_num, "dungeon master")
    
    # If there is more than zero
    if (n_dungmasts > 0) {
      game[game$player_id == dungmast_target_id(game, this_round_num) & 
             game$round_num == this_round_num,"is_dungmast_target"] <- TRUE
      # Currently, is_in_dungeon and is_dungmast_target are always identical. Not sure if I need to combine them or if it would be good to keep them separate for things down the road.
      game[game$player_id == dungmast_target_id(game, this_round_num) & 
             game$round_num == this_round_num,"is_in_dungeon"] <- TRUE
    }
  game
}
put_in_dungeon(game, 1)
```

```{r}
put_in_santuary <- function(game, this_round_num) {
  
  # First get the number of angels remaining in the game
  n_priests <- get_n_role(game, this_round_num, "priest")
    
    # If there is more than zero
    if (n_priests > 0) {
      game[game$player_id == priest_target_id(game, this_round_num) & 
             game$round_num == this_round_num,"is_priest_target"] <- TRUE
      game[game$player_id == priest_target_id(game, this_round_num) & 
             game$round_num == this_round_num,"is_in_sanctuary"] <- TRUE
    }
  game
}
put_in_santuary(game, 1)
```


```{r}
everyone_do_their_thing <- function(game, this_round_num, verbose = TRUE) {
  game %>%
    make_werewolf_victim(this_round_num) %>%
    make_angel_save(this_round_num) %>%
    make_witch_save(this_round_num) %>%
    make_witch_kill(this_round_num) %>%
    put_in_dungeon(this_round_num) %>%
    put_in_santuary(this_round_num)
}
everyone_do_their_thing(game, 1)
```



## Role-specific getter functions

A helper function to extract the werewolf victim.

```{r}
get_werewolf_victim <- function(game, this_round_num) {
  victim_id <- game[game$is_werewolf_victim == TRUE & game$round_num == this_round_num,]$player_id
  
  # If there was no werewolf kill, it's "integer(0)", which has a length of 0. Return NA instead.
  ifelse(length(victim_id) > 0, victim_id, NA)
}
```

So now I can run this and it'll assign the werewolf victim that property in the `game` dataframe.

Same thing for the Angel.

```{r}
get_angel_target <- function(game, this_round_num) {
  target_id <- game[game$is_angel_target == TRUE & game$round_num == this_round_num,]$player_id
  
  # If there was no target, it's "integer(0)", which has a length of 0. Return NA instead.
  ifelse(length(target_id) > 0, target_id, NA)
}
```

```{r}
get_witch_save <- function(game, this_round_num) {
  target_id <- game[game$is_witch_save == TRUE & game$round_num == this_round_num,]$player_id
  
  # If there was no target, it's "integer(0)", which has a length of 0. Return NA instead.
  ifelse(length(target_id) > 0, target_id, NA)
}
```

```{r}
get_witch_kill <- function(game, this_round_num) {
  target_id <- game[game$is_witch_kill == TRUE & game$round_num == this_round_num,]$player_id
  
  # If there was no target, it's "integer(0)", which has a length of 0. Return NA instead.
  ifelse(length(target_id) > 0, target_id, NA)
}
```

```{r}
get_dungmast_target <- function(game, this_round_num) {
  target_id <- game[game$is_dungmast_target == TRUE & game$round_num == this_round_num,]$player_id
  
  # If there was no target, it's "integer(0)", which has a length of 0. Return NA instead.
  ifelse(length(target_id) > 0, target_id, NA)
}
```

```{r}
get_priest_target <- function(game, this_round_num) {
  target_id <- game[game$is_priest_target == TRUE & game$round_num == this_round_num,]$player_id
  
  # If there was no target, it's "integer(0)", which has a length of 0. Return NA instead.
  ifelse(length(target_id) > 0, target_id, NA)
}
```


## Mark people as dead

Here's a function that'll mark people as dead.

```{r}
make_dead <- function(game, player, this_round_num, cause) {
  
  # Mark that they died tonight (this row only)
  game[game$player_id == player & game$round_num == this_round_num,]$when_died <- "tonight"
  
  # Mark their case of death (this and all later rows)
  game[game$player_id == player & game$round_num >= this_round_num,]$cause_of_death <- cause
  
  # Mark that they're dead (all later rows, but not this row)
  game[game$player_id == player & game$round_num >  this_round_num,]$is_alive <- FALSE
  
  game
}
```




## Now run the logic

Now that I've got the `combos_latest.csv` spreadsheet, I have a place where the logic gets worked out. That works perfectly when I'm going through player by player and figuring out what happened *to* them. Right now, when I'm summarizing things, I'm going the opposite way: starting with the attackers and seeing who they target. When I want to summarize the night, it makes more sense to go this way. So, to edisplay this information (and to work out the logic), I'll need two pieces of information:

1. Who the person targetted and the nature of that target.

1. What else happened to that target.

That second part is taken care of with the combos information.

I'm still trying to figure out if I should loop through by person or by role. I think by person is easier, and it will allow for multiples in the future I think. 

Update: Okay, so I think I've done it. The problem: the game is *waaaaay* slower. Like it went from about 8 games a second to 1.5. I think the joining is very much slower than nested if else statements. 

```{r}
combos <- read_csv("combos_latest.csv")
run_logic <- function(game, this_round_num, verbose = TRUE) {
  
  for (p in get_round(game, this_round_num)$player_id) {

    this_players_role <- game[game$player_id %in% p,]$role[[1]]
    player_message <- glue_col("{blue Player {str_pad(p, side = 'left', width = 2)}} is a {blue {this_players_role}}") %>%
      str_pad(width = 46, side = "right")

    this_player_this_night <- game %>%
      filter(round_num == this_round_num,
             player_id == p)
    if (this_player_this_night$is_alive) {

      # Get all the information
      werewolf_victim <- get_werewolf_victim(game, this_round_num)
      angel_target    <- get_angel_target(game, this_round_num)
      witch_save      <- get_witch_save(game, this_round_num)
      witch_kill      <- get_witch_kill(game, this_round_num)
      dungmast_target <- get_dungmast_target(game, this_round_num)
      priest_target   <- get_priest_target(game, this_round_num)

      # For things that happened to them, get that message.
      player_nom <- glue("They")
      player_acc <- glue("them")
      this_player_this_night <- this_player_this_night %>%
        left_join(combos,
                  by = c("is_werewolf_victim", "is_angel_target", "is_witch_save", "is_witch_kill"))
      passive_message <- this_player_this_night$message
      
      
      # Independent events.
      if (identical(p, dungmast_target)) {
        if (str_detect(passive_message, "Nothing happened")) {
          passive_message <- "They were put in the Dungeon."
        } else {
          passive_message <- paste(passive_message, "They were also put in the Dungeon.")
        }
      }
      if (identical(p, priest_target)) {
        if (str_detect(passive_message, "Nothing happened")) {
          passive_message <- "They were put into Sanctuary."
        } else {
          passive_message <- paste(passive_message, "They were also put into Sanctuary.")
        }
      }

      # Only print if something happened.
      if (!str_detect(passive_message, "Nothing happened")) {
        if (verbose) { print(glue_col(player_message, passive_message)) }
      }

      if (this_player_this_night$result == "die") {
        game <- game %>%
          make_dead(p, this_round_num, cause = this_player_this_night$killer)
      }

    }
  }
  game
} 
```


## Simulate a full night

Now wrap this all as a function.

```{r}
night <- function(game, this_round_num, verbose = TRUE) {
  game %>%
    everyone_do_their_thing(this_round_num, verbose) %>%
    run_logic(this_round_num, verbose)
}
new_game() %>%
  night(1)
```

This means I can loop it.

```{r, eval = FALSE}
game <- new_game()
for (i in 1:6) {
  print(glue("\n\nNight {i}..."))
  game <- night(game, i)
}
```



# Day time phase

The daytime phase is going to be simpler. Cast the votes. For now, the vote will be random. Down the road, I'll need to actually keep track of all votes (making sure to prevent people in Dungeon from voting). For roles like the Prince, this is necessary. Also, in the summary I'll be able to see who voted for whom. Furthermore, in the simulations, I'll need to make sure that werewolves don't vote each other out.

```{r}
cast_votes <- function(game, this_round_num) {
  available_nominees <- game %>%
    filter(round_num == this_round_num,
           !is_in_sanctuary, # <- people in Sanctuary can't be voted off
           is.na(cause_of_death)) %>%
    pull(player_id)
  
  n_nominees <- 1
  nominee_id <- sample(available_nominees, n_nominees)
  return(nominee_id)
}
```

```{r}
make_voting_victim <- function(game, this_round_num, player) {
  game[game$player_id == player & game$round_num == this_round_num,"is_voted_off"] <- TRUE
  game
}
```

And a helper function to extract the person being voted off.

TODO: Make the voting less random. Nominate two random players, but make it so werewolves don't vote for their own.

```{r}
get_voting_victim <- function(game, this_round_num) {
  victim_id <- game[game$is_voted_off == TRUE & game$round_num == this_round_num,]$player_id
  
  # If no one is voted off (impossible?), it's "integer(0)", which has a length of 0. Return NA instead.
  ifelse(length(victim_id) > 0, victim_id, NA)
}
```

```{r}
voted_off_message <- function(game, this_round_num) {
  
  voting_victim <- get_voting_victim(game, this_round_num)
  their_role <- get_role_from_player_id(game, voting_victim)
  
  if (length(voting_victim) == 1) {
    m <- glue_col("{blue Player {voting_victim}} ({blue {their_role}}) was {red voted off}!")
  } else {
    m <- glue_col("{red There are more than two voting victims and I'm not sure what to do!}")
  }
  m
}
```

Now wrap this all as a function.

```{r}
voting <- function(game, this_round_num, verbose = TRUE) {
  
  voting_victim <- cast_votes(game, this_round_num)
  
  # First, let the voting happen
  game <- make_voting_victim(game, this_round_num, voting_victim) %>%
    make_dead(voting_victim, this_round_num, "voting")
  
  if (verbose) { print(voted_off_message(game, this_round_num)) }
  
  game
}
```



# Check for game over

```{r}
check_for_game_over <- function(game, this_round_num, verbose = TRUE) {
  tonight <- game %>%
    filter(round_num == this_round_num)
  
  remaining_players <- tonight %>%
    filter(is.na(cause_of_death))
  remaining_werewolves <- tonight %>%
    filter(is.na(cause_of_death), role == "werewolf")
  
  n_remaining_players <- nrow(remaining_players)
  n_remaining_werewolves <- nrow(remaining_werewolves)
  n_remaining_townspeople <- n_remaining_players - n_remaining_werewolves
  
  
  if (n_remaining_werewolves >= n_remaining_townspeople) {
    if (verbose) {
      print(glue_col("{\"     \"}{green Game over!} Of the {n_remaining_players} people left, {n_remaining_werewolves} are werewolves, meaning they outnumber everyone else and they win!"))
    }
    return(TRUE)
    
  } else if (n_remaining_werewolves == 0) {
    if (verbose) {
      print(glue_col("{\"     \"}{green Game over!} The werewolves have been eliminated! Just {n_remaining_townspeople} people remain."))
    }
    return(TRUE)
    
  } else {
    if (verbose) {
      print(glue_col("{\"     \"}{silver Current Status:} {n_remaining_werewolves} werewolves, {n_remaining_townspeople} townspeople, and {n_remaining_players} total."))
    }
    return(FALSE)
  }
}
```


# Simulate an entire game

Now that I have everything ready, I'm ready to simulate an entire game.

```{r}
simulate_game <- function(game, n_players = 12, n_werewolves = 4, other_roles = "default", verbose = TRUE) {
  
  # Create a new dataset from scratch
  if (missing(game)) {
    game <- new_game(n_players = 12, n_werewolves = 4, other_roles)  
  }
  
  # This will be set to TRUE once the game is over.
  game_over <- FALSE
  
  # Loop through each night.
  n_nights <- n_players
  final_round <- 0
  for (i in 1:n_nights) {
    final_round <- i
    
    # If the game is already over, just skip to the next night.
    if (game_over == TRUE) { break }
    
    # Print the night number and do the nighttime stuff.
    if (verbose) { print(glue("\n\nNight {i}...")) }
    game <- night(game, i, verbose)
    # Check to see if the game is over.
    game_over <- check_for_game_over(game, i, verbose)
    if (game_over == TRUE) { break }
    
    if (verbose) { print(glue("\nDay {i}...")) }
    # Daytime phase: voting
    game <- voting(game, i, verbose)
    
    # Check to see if the game is over.
    game_over <- check_for_game_over(game, i, verbose)
    if (game_over == TRUE) { break }
  }
  
  game %>%
    filter(round_num <= final_round)
}
game <- simulate_game()
```


## Summarize the game


```{r}
print_game_summary <- function(game) {
  
  # Go through player by player
  for (p in unique(game$player_id)) {
    this_players_role <- game[game$player_id %in% p,]$role[[1]]
    print(glue_col("{blue Player {p}} was a {blue {this_players_role}}"))
    
    # Go through round by round
    this_players_info <- game %>% filter(player_id == p)
    for (n in this_players_info$round_num) {
      
      this_player_this_night <- this_players_info %>% filter(round_num == n)
      if (this_player_this_night$is_alive) {
        
        # Get all the information
        werewolf_victim <- get_werewolf_victim(game, n)
        angel_target    <- get_angel_target(game, n)
        witch_save      <- get_witch_save(game, n)
        witch_kill      <- get_witch_kill(game, n)
        dungmast_target <- get_dungmast_target(game, n)
        priest_target   <- get_priest_target(game, n)
          
        # Start with a vector of length 3. Later, the second element will be deleted if needed.
        messages <- list("{\"  \"}Round {n}:",
                         " (nothing)",
                         "\n")
        
        # Active
        if (this_players_role == "werewolf") {
          if (!is.na(werewolf_victim)) {
            if (identical(werewolf_victim, angel_target)) {
              messages <- append(messages, "{\"    \"}They {yellow tried} to kill Player {werewolf_victim} but were {yellow foiled} by the Angel.\n")  
            } else if (identical(werewolf_victim, witch_save)) {
              messages <- append(messages, "{\"    \"}They {yellow tried} to kill Player {werewolf_victim} but were {yellow foiled} by the Witch.\n")  
            } else {
              messages <- append(messages, "{\"    \"}They {red killed} Player {werewolf_victim}.\n")  
            }
            
            # If there is not a werewolf victim.
          } else {
            messages <- append(messages, "{\"    \"}{yellow for some reason there wasn't a werewolf victim???}\n")
          }
          
          
        } else if (this_players_role == "angel") {
          if (angel_target == werewolf_victim) {
            messages <- append(messages, "{\"    \"}They {green saved} Player {angel_target} from the werewolves!\n")
          } else {
            messages <- append(messages, "{\"    \"}They (benignly) {yellow saved} {angel_target}!\n")
          }
          
          
        } else if (this_players_role == "witch") {
          
          if (is.na(witch_save)) {
            has_already_saved <- game %>%
              filter(round_num < n,
                     is_witch_save) %>%
              nrow() 
            if (has_already_saved > 0) {
              messages <- append(messages, "{\"    \"}They already used their save.\n")
            } else {
              messages <- append(messages, "{\"    \"}They chose to not use their save.\n")
            }
          } else {
             messages <- append(messages, "{\"    \"}They chose to {green save} Player {witch_save} from the werewolves.\n")
          }
        
          if (is.na(witch_kill)) {
            has_already_killd <- game %>%
              filter(round_num < n,
                     is_witch_kill) %>%
              nrow() 
            if (has_already_killd > 0) {
              messages <- append(messages, "{\"    \"}They already used their kill.\n")
            } else {
              messages <- append(messages, "{\"    \"}They chose to not use their kill.\n")
            }
          } else {
            messages <- append(messages, "{\"    \"}They chose to {red kill} Player {witch_kill}.\n")
          }
          
          
        } else if (this_players_role == "dungeon master") {
            messages <- append(messages, "{\"    \"}They put Player {dungmast_target} in the dungeon\n")
            
        } else if (this_players_role == "priest") {
            messages <- append(messages, "{\"    \"}They put Player {priest_target} into sanctuary\n")
        }
        
        
        # For things that happened to them, get that message.
        player_nom <- "They"
        player_acc <- "them"
        passive_message <- this_player_this_night %>%
          left_join(combos, 
                    by = c("is_werewolf_victim", "is_angel_target", "is_witch_save", "is_witch_kill")) %>%
          pull(message)
        messages <- append(messages, paste0("{\"    \"}", passive_message))
        
        
        # If anything happened, remove the "(nothing)" part of the list.
        if (length(messages) != 3) {
          messages <- messages[-2]
        }
        
        # Print it all out.
        messages %>%
          glue_collapse() %>%
          glue_col() %>%
          print()
      }
    }
  }
}
print_game_summary(game)
```

## Simulate many games

Here are some functions to help with the simulations.

```{r, message = FALSE}
how_many_remaining <- function(game, this_role) {
  if (missing(this_role)) {
    this_role <- game %>%
      pull(role) %>%
      unique()
  }
  
  game %>%
    filter(round_num == max(round_num),
           role %in% this_role,
           is.na(cause_of_death)) %>%
    nrow()
}
```

```{r}
run_simulation <- function(n_sims = 100, n_players = 15, n_werewolves = 3, other_roles = "default") {
  
  tibble(sim_num = 1:n_sims) %>%
    mutate(game = invoke_map(new_game, 
                             n_players = n_players, 
                             n_werewolves = n_werewolves,
                             other_roles = other_roles),
           game = map(game, simulate_game, verbose = FALSE),
           remaining_players = map_int(game, how_many_remaining),
           remaining_townspeople = map_int(game, how_many_remaining, "townsperson"),
           remaining_werewolves  = map_int(game, how_many_remaining, "werewolf"),
           who_won = case_when(remaining_werewolves >= remaining_townspeople ~ "werewolves", 
                               remaining_werewolves == 0 ~ "townspeople",
                               TRUE ~ "townspeople"),
           who_won = factor(who_won))
}
```

Here's where I actually run the simulation.

Stats: 

* In the old version, I could do 19000 simulations in 40 minutes, or about 8.3 games per second.

* With the new version, it takes 55 minutes for 1890 simulations, or 1.75sec per game (like 14 times slower). Yikes. If I want to take this further, I need to really figure out how to cut down on processing time.

```{r}
start_time <- Sys.time()
name <- "Werewolves, Angel, Witch, Dungeon Master, Priest, and Townspeople"
sims <- expand.grid(n_players = 12:15, n_werewolves = c(3:4)) %>% # 3:40 players, 1:20 werewolves
  filter(n_players > n_werewolves * 2) %>%
  add_column(n_sims = 2) %>% # 50 simulations
  rowid_to_column("sim_group_id") %>%
  mutate(game_collection = pmap(list(n_sims, n_players, n_werewolves), run_simulation, 
                                other_roles = "default")) %>%
  print()
Sys.time() - start_time
```

Here's what the structure is like by the way.

```{r}
# Each individual game
# sims$game[[1]]$game[[1]]

# Each collection of games
# sims$game[[1]]

# print_game_summary(sims$game[[1]]$game[[1]])
```

Summarize the games.

```{r, message = FALSE, warning = FALSE}
n_sims <- sims %>% unnest() %>% nrow() %>% print()
sims_summary <- sims %>%
  unnest() %>%
  group_by(n_players, n_werewolves) %>%
  summarize(n_sims = first(n_sims),
            remaining_players = mean(remaining_players),
            remaining_townspeople = mean(remaining_townspeople),
            remaining_werewolves = mean(remaining_werewolves),
            werewolf_win_percent = sum(who_won == "werewolves") / n_sims) %>%
  ungroup() %>%
  mutate_at(vars(n_players, n_werewolves, n_sims), as.integer) %>%
  print()
```

## Load and save if needed

Save this game for later.

```{r}
# The summary is 10 KB. The unnested sims data is 412 MB. 
write_csv(sims_summary, paste0("simulations/", name, ".csv"))
```

Alternatively, read in already saved data. Good for reproducing plots.

```{r}
name <- "Werewolves and Townspeople"
name <- "Werewolves, 1 Angel, and Townspeople"
name <- "Werewolves, 1 Angel, 1 Witch (save only), and Townspeople"
sims_summary <- read_csv(paste0("simulations/", name, ".csv"))
n_sims <- sims_summary %>% pull(n_sims) %>% sum()
```

## Visualize

Actually make the plot.

```{r, fig.height = 4, fig.width = 6}
p <- ggplot(sims_summary, aes(n_players, n_werewolves, color = werewolf_win_percent)) + 
  geom_point(size = 4, shape = "square") + 
  scale_color_gradientn(colors = c("#762A83", "#F7F7F7", "#1B7837"), 
                        values = c(0, 0.5, 1),
                        limits = c(0, 1),
                        labels = scales::percent) + 
  scale_x_continuous(limits = c(3, 40)) + 
  scale_y_continuous(limits = c(1, 20)) + 
  labs(title = "Who wins in a game of Werewolf?",
       subtitle = paste("Based on", n_sims, "simulated games"),
       caption = paste("Roles included:", name),
       x = "Number of players",
       y = "Number of werewolves",
       color = "Chances that the\nWerewolves Win") + 
  coord_fixed(1) +
  theme_classic() + 
  theme(legend.position = c(0.13, 0.63))
p
```

```{r}
ggsave(paste0("plots/", name, ".pdf"), plot = p, height = 4, width = 6)
```

For the blog post.

```{r, fig.height = 4, fig.width = 6}
p + coord_cartesian() + 
  theme(panel.background = element_blank(), 
          plot.background = element_rect(fill = "gray96", colour = NA), 
          legend.background = element_rect(fill = "transparent", colour = NA), 
          legend.key = element_rect(fill = "transparent", colour = NA)) + 
  ggsave(filename = paste0("plots/", name, ".jpeg"), height = 4, width = 6, dpi = 300)
```

## Combo info

```{r, warning = FALSE}
combo_stats <- sims %>%
  unnest() %>%
  unnest() %>%
  left_join(combos, by = c("is_werewolf_victim", "is_angel_target", "is_witch_save", "is_witch_kill")) %>%
  group_by(combo, message) %>%
  count() %>%
  ungroup() %>%
  mutate(n_per_game = round(n / n_sims, 3),
         one_in_n_games = ceiling(n_sims / n),
         message = str_replace_all(message, "\\{player_nom", "They"),
         message = str_replace_all(message, "\\{player_acc", "them"),
         message = str_replace_all(message, "\\{silver", ""),
         message = str_replace_all(message, "\\{red ", ""),
         message = str_replace_all(message, "\\{yellow ", ""),
         message = str_replace_all(message, "\\{green ", ""),
         message = str_replace_all(message, "\\}", "")) %>%
  arrange(-n) %>%
  print()
View(combo_stats)
```