Star Wars: Galaxy of Heroes – who knew a mobile game could be so complicated?!
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
How I started playing
Back in 2015, during the boring period between Christmas and New Year, I decided to try out a Star Wars mobile game. Star Wars: Galaxy of Heroes is essentially a jazzed up version of Top Trumps where you collect characters, upgrade them, and use them to earn rewards.
What started out as a curiosity ended up being quite an addictive hobby, and the number of features and game modes (and new characters to unlock!) grew quickly. After quitting the game due to the massively disruptive introduction of “mods”, which allowed you to finely tune the stats of your characters, I returned to the game 9 months later to find that the developers had reduced the game destroying effects they had initially caused.
It was around this time that I was beginning to learn R, and was looking for a personal project to increase my competence. Fortunately, SWGOH is a very data intensive (but unfortunately time intensive) game, and the player community was screaming out for some tools to help them plan and manage their resources. Key among the tools that players were crying out for was some kind of mod management utility.
What are mods??
Before I get into mods, it’s probably worth explaining some things. Firstly, this game is highly competitive (and addictive). One of the game modes allows you to pit a team of 5 of your chosen characters against other people’s teams, with a ranking system that gives various rewards, including crystals. Crystals are the base currency of the game and actually have a monetory value, at least in so far as it’s crystals that are bought by Pay-to Win players. Therefore this particular game mode is extremely important for players that want to progress quickly. Winning in this game mode depends on the abilities and stats of your team members, and a general rule of thumb is speed is king, as it means your characters can take more turns than your opponents’.
Speed isn’t the only stat that characters have. In facts there’s a whole array of different stats including physical damage, special damage, potency, and tenacity, and some of the interactions of these stats when in battle can be rather complex. The introduction of mods allowed players to enhance particular stats to magnify particular strengths of their characters (or toons) or bolster their weaknesses. Each toon has six slots in which to put mods, each of which is a particular shape, and will only take mods of the shape. In fact mods have several different features, which makes the whole thing annoyingly complex:
- Shape: Square, Diamond, Circle, Arrow, Triangle, or Cross;
- Primary stat enhancement: A big boost for a particular stat;
- Secondary stat enhancements: An additional little boost for up to 4 stats;
- Level: Spending in-game credits to increase the level of the mod (max level 15) to increase the stat enhancements;
- Pips: Each mod has 1 to 5 pips signifying the quality of the mod; the higher the number of pips, the bigger the potential enhancements;
- Set Bonus: An association with a particular stat. If you use a set number of mods of a particular stat association, you gain a bonus increase in that stat (which is increased even more if all the mods in that set are max level 15).
Phew!! The common problem players would have would be an inventory of hundreds of mods, dozens of toons to put them on, and finding the time to decide which were the best mods to put on which toons…definitely a need for some automation here! If you’re interested, there’s a YouTube video (and others) explaining mods here.
Laying the groundwork
Before I get into how I tried to tackle the problem (and I attempted several methods), it’s probably worth first getting the relatively straightforward stuff out of the way and show how I codified the various rules and reference values that my script would use.
First off, I made use of the tidyverse package, and began defining some names:
library(tidyverse)
slots <- c("Square","Diamond","Circle",
"Arrow","Triangle","Cross")
stat_names <- c("Speed",
"Speed %",
"Potency %",
"Tenacity %",
"Offense",
"Offense %",
"Protection",
"Protection %",
"Critical Chance %",
"Critical Damage %",
"Defense",
"Defense %",
"Health",
"Health %")
Next I build up a dataframe which holds the maximum theoretical enhancements possible for each stat (I planned to use this to do some normalisation later so I could compare like with like). So for example, the maximum Speed enhancement you can get from a primary stat on any one mod is +30, similarly for Offense % is +5.88%. However the max_nprim vector contains the maximum number of mods a toon can hold with that primary stat enhancement, so it’s only one for Speed, but four for Offense %, which means an enhancement of 23.52% is possible for primary stat enhancements alone. Whilst the maximum primary enhancements were quite easy to get, there is more randomness in the secondary stats, so I basically had to base the figures off the maximum values I had ever seen. The maximum set bonuses are always additional percentage increases.
max_prim <- c(30,0,24,24,0,5.88,0,23.5,12,36,0,11.75,0,5.88)
max_nprim <- c(1,0,1,1,0,4,0,4,1,1,0,4,0,4)
max_sec <- c(27,0,9.63,10.19,201,2.44,3630,9.74,10.14,0,41,7.27,1916,5.01)
max_nsec <- c(5,0,6,6,6,6,6,6,6,0,6,6,6,6)
max_set_bonus <- c(0,10,30,30,0,10,0,0,15,30,0,15,0,15)
max_stats <- data.frame(Max.Primary = max_prim * max_nprim,
Max.Secondary = max_sec * max_nsec,
Max.Set.Bonus = max_set_bonus,
row.names = stat_names,
stringsAsFactors = FALSE)
rm(max_prim, max_nprim, max_sec, max_nsec, max_set_bonus)
max_stats
## Max.Primary Max.Secondary Max.Set.Bonus
## Speed 30.00 135.00 0
## Speed % 0.00 0.00 10
## Potency % 24.00 57.78 30
## Tenacity % 24.00 61.14 30
## Offense 0.00 1206.00 0
## Offense % 23.52 14.64 10
## Protection 0.00 21780.00 0
## Protection % 94.00 58.44 0
## Critical Chance % 12.00 60.84 15
## Critical Damage % 36.00 0.00 30
## Defense 0.00 246.00 0
## Defense % 47.00 43.62 15
## Health 0.00 11496.00 0
## Health % 23.52 30.06 15
Next, I define how many mods are needed to obtain the set bonuses (the zeroes mean that there are no set bonuses for that stat). The lower (and upper) vector gives the % enhancement in that stat if you reach that number (and if all of the mods in that set are at maximum level)
set_bonus_n <- c(0,4,2,2,0,4,0,0,2,4,0,2,0,2)
set_bonus_lower <- c(0,5,5,5,0,5,0,0,2.5,15,0,2.5,0,2.5)
set_bonus_upper <- c(0,10,10,10,0,10,0,0,5,30,0,5,0,5)
set_bonus_rules <- data.frame(Number = set_bonus_n,
Bonus = set_bonus_lower,
Max.Bonus = set_bonus_upper,
row.names = stat_names,
stringsAsFactors = FALSE)
rm(set_bonus_n, set_bonus_lower, set_bonus_upper)
set_bonus_rules
## Number Bonus Max.Bonus
## Speed 0 0.0 0
## Speed % 4 5.0 10
## Potency % 2 5.0 10
## Tenacity % 2 5.0 10
## Offense 0 0.0 0
## Offense % 4 5.0 10
## Protection 0 0.0 0
## Protection % 0 0.0 0
## Critical Chance % 2 2.5 5
## Critical Damage % 4 15.0 30
## Defense 0 0.0 0
## Defense % 2 2.5 5
## Health 0 0.0 0
## Health % 2 2.5 5
Reading in game data
This was the tricky bit. There is a website that players use to sync their game accounts with, swgoh.gg, and somehow they had managed to reverse engineer the game to allow users to sync their game data with the website. Unfortunately no API was available, so there was really only one option that I could see - web scraping. I had a go, but didn’t get anywhere and realised this was beyond my skills for now, so a very kind individual behind the website Crouching Rancor sent me a json file containing sample data of the mods contained within his game account.
I imported this file and constructed a dataframe containing all the game data I should need to complete my script.
library(jsonlite)
mods_json <- fromJSON("data/swgoh-mods-sample.json")
mods_info <- data.frame(Mod.ID = mods_json$all_mods$mod_uid,
Initial.Toon = mods_json$all_mods$characterName,
Shape = mods_json$all_mods$slot,
Set = mods_json$all_mods$set,
Level = mods_json$all_mods$level,
Primary = mods_json$all_mods$primaryBonusType,
Primary.Value = mods_json$all_mods$primaryBonusValue,
Secondary1 = mods_json$all_mods$secondaryType_1,
Secondary1.Value = mods_json$all_mods$secondaryValue_1,
Secondary2 = mods_json$all_mods$secondaryType_2,
Secondary2.Value = mods_json$all_mods$secondaryValue_2,
Secondary3 = mods_json$all_mods$secondaryType_3,
Secondary3.Value = mods_json$all_mods$secondaryValue_3,
Secondary4 = mods_json$all_mods$secondaryType_4,
Secondary4.Value = mods_json$all_mods$secondaryValue_4,
Pips = mods_json$all_mods$pips,
stringsAsFactors = FALSE)
rm(mods_json)
head(mods_info)
## Mod.ID Initial.Toon Shape Set Level
## 1 -2uujN4fSzq9Y5_Bo5B8ew Poe Dameron square speed 15
## 2 -BCBuYQJSVGcfsicCBbx2A Biggs Darklighter triangle critdamage 15
## 3 -DSU8UhkTqyXQp1tuhSfWg Darth Sidious triangle critdamage 12
## 4 -FGSr-lSREyxoRboW8LK4A unassigned arrow health 15
## 5 -jpEqtA8Q9OQtm-z4gx0rQ unassigned diamond potency 15
## 6 -Lf6errXS0OCiVMEKaUg5w unassigned cross critdamage 15
## Primary Primary.Value Secondary1 Secondary1.Value
## 1 Offense +5.88% Speed +6
## 2 Defense +11.75% Health % +1.1
## 3 Critical Chance +9.75% Defense % +0.87
## 4 Offense +1.88% Critical Chance +1.6%
## 5 Defense +11.75% Offense +69
## 6 Protection +7.5% Defense % +0.78
## Secondary2 Secondary2.Value Secondary3 Secondary3.Value Secondary4
## 1 Potency +2.09% Health +347 Defense %
## 2 Speed +4 Defense +5 Offense
## 3 Speed +5 Offense % +0.54 Health %
## 4 Protection % +0.6 Tenacity +0.65% Defense
## 5 Protection +457 Potency +1.25% Speed
## 6 Speed +1 Offense % +0.23 Potency
## Secondary4.Value Pips
## 1 +1.4 5
## 2 +38 5
## 3 +0.99 5
## 4 +2 1
## 5 +3 5
## 6 +0.59% 1
Since a typical user would have hundreds of mods, I filtered this list down to only contain the best; maximum pips, maximum level, and some speed enhancement (“speed is king”!). As I’ll discuss later, problem size becomes a real issue!
dim(mods_info)
## [1] 547 16
mods_info <- mods_info %>% filter(Pips == "5",
Level == "15",
(Primary == "Speed"
|Secondary1=="Speed"
|Secondary2=="Speed"
|Secondary3=="Speed"
|Secondary4=="Speed"))
dim(mods_info)
## [1] 108 16
Next, I get a list of unique MOD ID numbers and Toon names (looking back at this I should have used distinct(), filter(), and arrange() from dplyr):
mod_list <- mods_info$Mod.ID toon_list <- unique(mods_info$Initial.Toon) %>% sort() toon_list <- toon_list[toon_list != "unassigned"]
Cleaning it up
Then some more cleaning up, replacing double quotes with single quotes, ensuring consistent naming, and converting to numerics:
toon_list <- stringr::str_replace_all(toon_list, "\"", "'")
mods_info$Initial.Toon <- stringr::str_replace_all(mods_info$Initial.Toon, "\"", "'")
mods_info$Shape <- tools::toTitleCase(mods_info$Shape)
mods_info$Set <- tools::toTitleCase(mods_info$Set)
mods_info$Set <-stringr::str_replace_all(mods_info$Set, "Critdamage", "Critical Damage")
mods_info$Set <-stringr::str_replace_all(mods_info$Set, "Critchance", "Critical Chance")
mods_info$Set <- mods_info$Set %>% paste("%")
mods_info$Primary <- mods_info$Primary %>% paste("%")
mods_info$Primary <- stringr::str_replace_all(mods_info$Primary, "Speed %", "Speed")
mods_info[,c("Secondary1",
"Secondary2",
"Secondary3",
"Secondary4")] <- mods_info %>%
select(Secondary1,Secondary2,
Secondary3,Secondary4) %>%
sapply(function(x) {gsub("Potency","Potency %",x)}) %>%
sapply(function(x) {gsub("Tenacity","Tenacity %",x)}) %>%
sapply(function(x) {gsub("Critical Chance","Critical Chance %",x)})
mods_info[,c("Primary.Value",
"Secondary1.Value",
"Secondary2.Value",
"Secondary3.Value",
"Secondary4.Value")] <- mods_info %>%
select(Primary.Value,
Secondary1.Value,
Secondary2.Value,
Secondary3.Value,
Secondary4.Value) %>%
sapply(function(x) {gsub("\\+","",x)}) %>%
sapply(function(x) {gsub("%","",x)})
mods_info$Level <- as.numeric(mods_info$Level)
mods_info$Primary.Value <- as.numeric(mods_info$Primary.Value)
mods_info$Secondary1.Value <- as.numeric(mods_info$Secondary1.Value)
mods_info$Secondary2.Value <- as.numeric(mods_info$Secondary2.Value)
mods_info$Secondary3.Value <- as.numeric(mods_info$Secondary3.Value)
mods_info$Secondary4.Value <- as.numeric(mods_info$Secondary4.Value)
mods_info$Pips <- as.numeric(mods_info$Pips)
What I also wanted to do was make the numbers easy. Each toon could hold 6 mods (one of each shape), so I wanted to make sure I had enough mods to fit all the toons with none remaining, and enough toons to receive all mods with none remaining. This involves creating a number of “ghost mods” and “ghost toons”; the ghost mods “fill” the empty slots, and the ghost toons just hold the unassigned mods. First I calculate how many mods of each shape exist, and how many extra ghost toons are needed (in this case, none) and add them to the list:
(NoShapes <- map_int(slots, function(x) {mods_info %>% filter(Shape == x) %>% nrow()}))
## [1] 14 26 18 19 13 18
(NoGhostToons <- max(max(NoShapes) - length(toon_list),0))
## [1] 0
if (NoGhostToons > 0) {
ghost_toon <- "Ghost toon"
ghost_toons <- paste(ghost_toon, 1:NoGhostToons)
toon_list <- c(toon_list, ghost_toons)
rm(ghost_toon, ghost_toons)
}
Now the number of toons is fixed, I can calculate how many ghost mods I need of each shape, create their stats, and add them to the list. Note that the number of mods trebles for this sample input file:
(NoGhostShapes <- pmax(length(toon_list) - NoShapes,0))
## [1] 27 15 23 22 28 23
for (i in 1:length(slots)) {
if (NoGhostShapes[i] > 0) {
ghost_mod <- paste("Ghost", slots[i], "mod")
ghost_mods <- paste(ghost_mod, 1:NoGhostShapes[i])
mod_list <- c(mod_list, ghost_mods)
extra_rows <- data.frame(ghost_mods,
"unassigned",
slots[i],
"None",
1,
NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,
1,
stringsAsFactors = FALSE)
names(extra_rows) <- names(mods_info)
mods_info <- mods_info %>% bind_rows(extra_rows)
}
}
rm(extra_rows, ghost_mod, ghost_mods)
dim(mods_info)
## [1] 246 16
The final piece of information needed is what weightings to give the various stats, and also what importance to place on various toons. The intention was to allow the user to focus on their most used toons, and to also allow the user to define which stats they would like the program to focus on enhancing for each toon. For now, I just assigned these weightings randomly with an integer:
set.seed(50)
toon_priority <- sample(0:20,
size=length(toon_list),
replace = TRUE)
names(toon_priority) <- toon_list
toon_priority
## Ahsoka Tano Biggs Darklighter Boba Fett
## 14 9 4
## Chief Nebit CT-21-0408 'Echo' CT-5555 'Fives'
## 16 10 0
## CT-7567 'Rex' Darth Maul Darth Nihilus
## 14 13 0
## Dathcha Emperor Palpatine Finn
## 2 8 5
## First Order TIE Pilot General Kenobi Geonosian Soldier
## 13 1 5
## Grand Master Yoda Grand Moff Tarkin HK-47
## 14 17 7
## IG-86 Sentinel Droid IG-88 Ima-Gun Di
## 1 3 12
## Jawa Engineer Jawa Scavenger Jedi Knight Anakin
## 4 14 17
## Jyn Erso Kylo Ren Lando Calrissian
## 6 13 12
## Luke Skywalker Luminara Unduli Mace Windu
## 5 6 7
## Poe Dameron Qui-Gon Jinn R2-D2
## 7 8 9
## Resistance Pilot Resistance Trooper Rey
## 12 4 13
## Royal Guard Sabine Wren Teebo
## 2 14 7
## TIE Fighter Pilot Wedge Antilles
## 9 7
toon_stat_priority <- matrix(sample(0:10,
size = length(toon_list)*length(stat_names),
replace = TRUE),
nrow = length(toon_list),
ncol = length(stat_names))
rownames(toon_stat_priority) <- toon_list
colnames(toon_stat_priority) <- stat_names
head(toon_stat_priority)
## Speed Speed % Potency % Tenacity % Offense Offense %
## Ahsoka Tano 9 3 6 7 2 1
## Biggs Darklighter 3 5 5 5 7 8
## Boba Fett 1 5 5 3 3 2
## Chief Nebit 0 0 2 4 9 1
## CT-21-0408 'Echo' 7 0 0 9 4 7
## CT-5555 'Fives' 10 7 0 4 5 9
## Protection Protection % Critical Chance %
## Ahsoka Tano 3 9 7
## Biggs Darklighter 0 10 3
## Boba Fett 5 2 4
## Chief Nebit 5 5 8
## CT-21-0408 'Echo' 10 1 4
## CT-5555 'Fives' 10 3 8
## Critical Damage % Defense Defense % Health Health %
## Ahsoka Tano 7 5 8 1 0
## Biggs Darklighter 3 9 0 4 8
## Boba Fett 9 7 6 5 0
## Chief Nebit 6 7 9 10 8
## CT-21-0408 'Echo' 2 9 8 1 7
## CT-5555 'Fives' 4 0 3 5 10
Let the shenanigans begin!!
At this point it’s worth mentioning that my first effort was to try to get an optimisation algorithm working. In order to do that, I created a mod assignment array which represented all of the decision variables and basically consisted of 0s and 1s indicating whether a toon was equipped with that mod.
mod_assignment <- matrix(0, nrow=length(toon_list), ncol=length(mod_list)) rownames(mod_assignment) <- toon_list colnames(mod_assignment) <- mod_list
I had input values and weightings, all I needed now was an objective function. In order to create one, I first needed to create a helper function that could update every toon’s stat enhancements when a new set of mods were applied. This function takes a particular toon and stat, and then uses the mod_assignment array to figure out which mods have been applied, adds up the stats from primaries and secondaries, and then adds on set bonuses:
new_stat <- function(toon, stat, mod_assignment) {
toon_mods <- mod_list[mod_assignment[mod_assignment[toon,]>0]]
new_stat <- mods_info %>%
filter(Mod.ID %in% toon_mods) %>%
filter(Primary == stat) %>%
select(Primary.Value) %>%
colSums() +
mods_info %>%
filter(Mod.ID %in% toon_mods) %>%
filter(Secondary1 == stat) %>%
select(Secondary1.Value) %>%
colSums() +
mods_info %>%
filter(Mod.ID %in% toon_mods) %>%
filter(Secondary2 == stat) %>%
select(Secondary2.Value) %>%
colSums() +
mods_info %>%
filter(Mod.ID %in% toon_mods) %>%
filter(Secondary3 == stat) %>%
select(Secondary3.Value) %>%
colSums() +
mods_info %>%
filter(Mod.ID %in% toon_mods) %>%
filter(Secondary4 == stat) %>%
select(Secondary4.Value) %>%
colSums()
if (calc_bonuses <- TRUE) {
num_bonuses <- ifelse(set_bonus_rules[stat,"Number"] == 0,
0,
mods_info %>%
filter(Mod.ID %in% toon_mods, Set == stat) %>%
nrow() %/% set_bonus_rules[stat,"Number"])
num_max_bonuses <- ifelse(set_bonus_rules[stat,"Number"]==0,
0,
mods_info %>%
filter(Mod.ID %in% toon_mods, Set == stat) %>%
filter(Level == 15) %>%
nrow() %/% set_bonus_rules[stat,"Number"])
} else {
num_bonuses <- 0
num_max_bonuses <- 0
}
new_stat <- new_stat + num_max_bonuses * set_bonus_rules[stat,"Max.Bonus"] +
(num_bonuses - num_max_bonuses) * set_bonus_rules[stat,"Bonus"]
return(as.numeric(new_stat))
}
Next, the objective function calculates the overall score, which we wish to maximise. However this is where things began to get a bit fluid, and I was changing my approach without any kind of version control like Git. I can’t remember how I came about using the setNames() function, but the first line of the function is effectively a vectorised nested for-loop, applying the new_stat() function to every combination of toon and stat. The result is a matrix of enhancements for every toon and stat. These are then normalised with the max_stats dataframe, and the overall score calculated using the priority weightings.
overall_score <- function(mod_assignment) {
toon_stats <- setNames(object = data.frame(sapply(stat_names,
function(x) sapply(toon_list[1:(length(toon_list)-NoGhostToons)],
function(y) new_stat(y, x, mod_assignment))),
row.names = toon_list[1:(length(toon_list)-NoGhostToons)]),
nm = stat_names) %>% as.matrix()
toon_stats_norm <- sweep(toon_stats, 2, rowSums(max_stats), '/')
overall_score <- toon_priority[1:(length(toon_list)-NoGhostToons)] * rowSums(toon_stat_priority[1:(length(toon_list)-NoGhostToons)] * toon_stats_norm)
return(sum(overall_score))
}
Since the mod assignment matrix should only take the values 0 and 1, and any one toon can only be assigned one mod of each shape, I struggled finding an R package that could deal with this kind of problem. I eventually found the rgenoud package, but it quickly dawned on me that the problem was simply FAR too big for memory and I needed to rescope. The really time consuming part was the setNames() function above, and I attempted several things to speed things up, including not calculating the stats for the ghost toons, but to no avail. I also found that the genetic algorithm in rgenoud needed to find a certain number of feasible solutions in order to create future generations of potential solutions, but constraining the algorithm was beyond my abilities, e.g. stopping it from assigning two square mods to a toon. There were simply too many infeasible solutions that could be created as the algorithm explored the decision space.
Attempt 2: Brute force…
I abandoned optimisation, and then attempted a partial brute-force approach, modifying the data structures to force only one of each shape mod being assigned. My plan was to treat the problem as 6 ‘independent’ problems, i.e. finding effective ways of assigning the square mods, effective ways of assigning the triangle mods, etc.
First I split up the mods list into a dataframe, with a column for each shape:
mod_list_shape <- map(slots, function(x) {mods_info$Mod.ID[mods_info$Shape == x]}) %>%
as.data.frame()
names(mod_list_shape) <- slots
head(mod_list_shape)
## Square Diamond Circle
## 1 -2uujN4fSzq9Y5_Bo5B8ew -jpEqtA8Q9OQtm-z4gx0rQ 5GJk_0AyS2a-1WAiJiRITg
## 2 a79U_UGvQmypgizQRx8Tzw 2n6fhh6gTbSLV4uxuvE0Lg 7MbqYLFpQVW7rxgPpoRFtw
## 3 BFtZ9Ij6Qpe_5Kf6WDm96w 33hCaqVtSJCyuZU3lR76Ww 8xlsn3eVTEuVu18JvRfBuA
## 4 bnwcjrsJQ0moWp-mvJlMrQ 3iIvjj-SSfy-E8sPm6eJpw 9bQzGF6cSYyeW0uZ8u7FCg
## 5 C5NMzQauRNWHpa2-ni31NQ 7dJZO6JYSfOQ89IMuljSLg a5AwI1sIROSDYCRYrFn9ag
## 6 cdUpBP2PQvyczmrEu9z-7Q 8x7VtTxRQrWhyWralRdlrg Ao8i6ES6QBqZiQKuIKwLtg
## Arrow Triangle Cross
## 1 17zYpRcARLKlbRM5a-Tpkw -BCBuYQJSVGcfsicCBbx2A 26qCJ0PWR3CB8apb38l17g
## 2 1v6HSnVHSCOigsIn3x18Gg 48_oOrwMS1iWVAE-KOmVEQ 3v1_O4lbTAGINd3gsQ1O0w
## 3 AdHQrio1Ry-CjE4I3lab8A 6dA0oUFiSrOGomcaZxQUDA 5o7UuQ6vSmqKSP4qUlvBsQ
## 4 AlWHuiYGSReCuJERg7U1iw ACAy-17-TDqjtzqIWcns9g 6Xx4rsvoTxGBVeoCoECJSQ
## 5 aQsY--AqTd2kNTNCxPMSNQ ajhVqNkhR_SJgygX-R2SGg 74cDghpDSCmCyyLLj8Q_Aw
## 6 COV7jFELQFaN67a0eFhsdw G1RTvQBOTJeMadRUMh43FQ AH7-UZQ6Roa0u6__RxghNg
I then define how many permutations of mod assignments I’m going to generate, and how many of the best ones I’m going to use to find the best overall solution:
permutations <- length(toon_list)*length(mod_list) top_permutations <- permutations %/% 10
I then create a number of data structures. First the mod_assignment array I used before is re-imagined, so that instead of each element being either 0 or 1, it now records the index of the appropriately shaped mod from the mod_list_shape dataframe. The slot_perms array is a temporary structure to hold all mod assignment permutations for a particular shape, the best of which get stored in the top_perms array. The top_perms array basically stores several versions of the mod_assignment array with the best scores.
mod_assignment <- matrix(0, nrow=length(toon_list), ncol=length(slots)) rownames(mod_assignment) <- toon_list colnames(mod_assignment) <- slots slot_perms <- matrix(0, nrow=permutations, ncol=length(toon_list)) top_perms <- array(0, c(top_permutations, length(toon_list), length(slots)))
The code below loops through each shape to find the best per-shape permutations. Since it’s operating on each shape independently, a variable calc_bonuses ensures that the overall_score function does not try to calculate set bonuses, since that requires looking across shapes in a mod set.
The first code chunk in the loop checks whether there are ghost mods AND ghost toons and then goes through each Ghost mod and permutation about to be generated and ensures it is assigned to a ghost toon (so that the problem space is reduced as much as possible). The second code chunk goes on to randomly assign the other mods.
The third code chunk populates the mod_assignment array and goes on to calculate the scores for each assignment permutation. The final chunk finds the top scoring assignment permutations. It’s worth noting that I wrote my own top_n() function, not realising one already existed in the dplyr package! I’ve left it out here and I’ve not tested whether the code still works using the dplyr function.
calc_bonuses <- FALSE
for (i in 1:length(slots)) {
# put ghost mods with ghost toons
for (j in 1:NoGhostShapes[i]) {
NoPreAssign <- min(NoGhostToons, NoGhostShapes[i])
if (NoPreAssign > 0 ) {
for (k in 1:permutations) {
slot_perms[k, (length(toon_list) - NoPreAssign + 1):length(toon_list)] <-
(nrow(mod_list_shape) - NoPreAssign + 1):nrow(mod_list_shape)
}
}
}
# fill out remaining slots of slot_perms with random mods
for (k in 1:permutations) {
slot_perms[k, 1:(length(toon_list) - NoPreAssign)] <-
sample(1:(nrow(mod_list_shape) - NoPreAssign),
nrow(mod_list_shape) - NoPreAssign)
}
# get score of permutations
# fill out i'th column of mod_assignment
for (k in 1:permutations) {
message(slots[i], ", ", k, " out of ", permutations, " permutations")
mod_assignment[,i] <- slot_perms[k,]
perm_scores[k] <- overall_score(mod_assignment)
}
# get the top X and store in a 3D array (perm, toon, slot)
top_perms[1:top_permutations, 1:length(toon_list), i] <-
slot_perms[top_n(perm_scores, top_permutations),]
}
Finally, the mod assignment array is reused to repeatedly generate assignments composed of random samples of the top performing mods for each slot. The perm_scores vector holds all the overall scores for each permutation.
calc_bonuses <- TRUE
perm_scores <- matrix(0, nrow=permutations, ncol=1)
for (k in 1:permutations) {
mod_assignment <- matrix(c(top_perms[sample(1:top_permutations,1),,1],
top_perms[sample(1:top_permutations,1),,2],
top_perms[sample(1:top_permutations,1),,3],
top_perms[sample(1:top_permutations,1),,4],
top_perms[sample(1:top_permutations,1),,5],
top_perms[sample(1:top_permutations,1),,6]),
nrow=length(toon_list), ncol=length(slots))
rownames(mod_assignment) <- toon_list
colnames(mod_assignment) <- slots
perm_scores[k] <- overall_score(mod_assignment)
}
The eventual resignation…
The two approaches explained above are only a sample of approaches I tried, and I had tremendous difficulty getting any of them to produce something of value in reasonable runtimes. I was eventually left exploring approaches that would merely visualise potential assignments for users to choose from, cutting out some of the work involved. I reached a point where I concluded that, for now, the problem was too complex for me to produce something that had value (as it was probably designed to be).
One of the things I would do if I had to do it all again would be to make use of the map_* functions from the purrr package to get away from all that looping. I think when I wrote this code I was still trying to get my head around it conceptually. I dread to think how bad this code looks to the R gurus out there!
However, this little project really did cement my understanding of R data structures and gave me some invaluable R practice. I’d definitely be interested if anyone manages to crack this problem. From what I can tell, no one got as far as this from what I saw on the game forums, at least without doing optimisation on one toon at a time.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.