rules of engagement

Understanding the behaviour of a system requires an understanding of the elements of a system. But knowing the rules governing a complex system is not the same as being able to fully appreciate the impact of those interactions. For example the Game of Life has only four rules (plus the underlying geometry of the board) and yet can exhibit many non-obvious behaviours.

To quantify the damage output of a piece with a ranged attack we need to represent the rules governing that part of the game. A model’s owner rolls dice to attempt to hit the target. A missed shot could still scatter onto the target. Previously I created a script that determined whether a scattering area of effect in Warmachine would hit a target. A model is prevented from shooting if it is engaged by an enemy model. We also need to understand these rules governing how pieces are engaged as well as any other special effects.

This function takes objects representing the attacker and target, and the two other pertinent pieces of information. How far away are the two models from each other? And is the target model knocked down? I’m assuming here that we’re not trying to shoot if the attacking model is knocked down. The code checks all melee weapons on both models, and looks for a statistic RNG, which is generally 0.5 inches. This is a vectorized function: more than one distance value can be passed into it at once. This is a very efficient way to code in R since the  overhead is generally calling a function (creating a new environment), rather than performing operations.

#' @title Is Attacker Engaged/Engaging?
#' @param warjack list attacker warjack object with elements melee
#' @param target list target warjack object with elements melee
#' @param dist single numeric distance between bases
#' @param kd single logical is the target knocked down? (default \code{FALSE})
#' NB Knocked down models never engage
#' @return single logical
 
is.engaged <- function(warjack, target, dist, kd = FALSE) {
   
    if (any(is.na(dist))) { stop("dist is NA") }
   
    if (any(dist < 0)) { stop("dist is less than zero") }
   
    isEng <- rep(FALSE, times = length(dist))
   
    if (!is.element(c("melee"), names(warjack))) {
        warjack$melee <- list() }
   
    if (!is.element(c("melee"), names(target))) {
        target$melee <- list() }
   
    melee <- rep(0, 4)
   
    mm <- length(warjack$melee)
   
    for (mm in seq_along(warjack$melee)) {
       
        melee[mm] <- warjack$melee[[mm]]$stats["RNG"]
    }
   
    for (nn in seq_along(target$melee)) {
       
        melee[mm + nn] <- target$melee[[nn]]$stats["RNG"]
    }
   
    melee <- max(melee, na.rm = TRUE)
   
    isEng[!kd] <- c(melee >= dist)[!kd]
   
    return(isEng)
}

Of course I include some tests to give you confidence that the code does what it’s supposed to.

> tests <- vector(mode = "logical", length = 10)
>
> # TEST 1: destroyer dist 6 kd
> tests[1] <- !is.engaged(destroyer, destroyer, dist = 6, kd = TRUE)
>
> # TEST 2: destroyer dist 2
> tests[2] <- !is.engaged(destroyer, destroyer, dist = 2, kd = FALSE)
>
> # TEST 3: destroyer dist 0.5
> tests[3] <- is.engaged(destroyer, destroyer, dist = 0.5, kd = FALSE)
>
> # TEST 4: spriggan dist 2
> tests[4] <- is.engaged(spriggan, destroyer, dist = 2, kd = FALSE)
>
> # TEST 5: scythean conquest dist 0.5
> tests[5] <- is.engaged(scythean, conquest, dist = 0.5)
>
> # TEST 6: scythean conquest dist 2
> tests[6] <- is.engaged(scythean, conquest, dist = 2)
>
> # TEST 7: scythean conquest dist -2
> test7 <- try(is.engaged(scythean, conquest, dist = -2), silent = TRUE)
> tests[7] <- is(test7, "try-error")
>
> # TEST 8: scythean conquest dist -2
> test8 <- try(is.engaged(scythean, conquest, dist = NA), silent = TRUE)
> tests[8] <- is(test8, "try-error")
>
> # TEST 9: scythean conquest dist 0:3
> test9 <- is.engaged(scythean, conquest, dist = 0:3)
> tests[9] <- all(test9 == c(TRUE, TRUE, TRUE, FALSE))
>
> # TEST 10: scythean conquest dist 0:3 kd rep(c(TRUE, FALSE), each = 2)
> test10 <- is.engaged(scythean, conquest, dist = 0:3, kd = rep(c(TRUE, FALSE), each = 2))
> tests[10] <- all(test10 == c(FALSE, FALSE, TRUE, FALSE))
>
> if (all(tests)) { cat("is.engaged is okay\n") } else { cat(sum(!tests), "known problem(s)\n") }
is.engaged is okay

Once we can check whether the model is engaged, we can start taking shots. The purpose of this function is to take a single attack. Managing the whole activation will be managed by another function which takes multiple shots (and decides whether that is possible). We need to provide the attacker, the target, a description of the attacker’s desired behaviour (boosting attack or damage), resources and distance from the target.

For ease of testing the dice rolls are passed into the predicting function, rather than being generated by the function itself. An index, pos, keeps track of which dice have already been used. The function returns key information, most notably the damage inflicted, but also a track of other resources, including focus remaining and pos, the dice index.

If the target is engaged by or engaging the attacker, there is no shot, and no focus is spent. If the area of effect scatters onto the target, the power of the attack is halved rounding up.

The function is partially vectorized allowing more than one distance value to be used at once. I started to fully vectorize it, but it was getting quite hard to read. Hopefully you can understand what the code is doing at each step. This is worth the performance loss in my opinion.

#' @title Perform a Ranged Attack
#' @param warjack list attacker warjack object with elements stats, range and melee and special
#' @param which single integer specify ranged weapon to use
#' @param target list target warjack object with elements stats and special
#'     stats has elements \enumerate{
#'     \item DEF single numeric NB should include effect of being knocked down
#'     (no adjustment here due to possible effect of other modifiers)
#'     \item ARM single numeric armour value
#'     \item BASE single numeric diameter of base (mm)
#' @param boost_hit single logical
#' @param boost_damage single logical
#' @param foc single numeric number of focus
#' @param kd single logical is the target knocked down? (default \code{FALSE})
#' @param dist numeric vector distance between bases (default 6)
#' @param dice numeric vector (default \code{sample(1:6)})
#' @param pos single numeric
#' @param recycle single logical should dice be recycled for each value of dist? (default \code{FALSE})
#' @return named vector with elements \enumerate{
#'     \item damage amount of damage inflicted
#'     \item focus remaining focus following attack
#'     \item knocked down is the target knocked down? 0: No, 1: Yes
#'     \item position which die to use next
#'     \item hit was the target hit? 0: No, 1: Yes
#' }
#' @examples
#'     destroyer <- list(stats = c(SPD = 4, MAT = 6, RAT = 4, DEF = 10, ARM = 20, BASE = 50),
#'         range = list(bombard = list(
#'             stats = c(RNG = 14, POW = 14, AOE = 3),
#'             special = c("arcing"))),
#'         melee = list(axe = list(stats = c(RNG = 0.5, PAS = 12),
#'                 special = c("crit amp"))))
#'     shot(destroyer, which = 1, target = destroyer,
#'         boost_hit = TRUE, boost_damage = TRUE, foc = 3, dist = 10,
#'         dice = c(1, 5, 4, 1, 1, 2))
shot <- function(warjack, which = 1, target = list(stats = c(DEF = 12, ARM = 18, BASE = 50)),
    boost_hit = TRUE, boost_damage = TRUE, foc = 0, kd = FALSE, dist = 6,
    dice = sample(1:6, size = 20, replace = TRUE), pos = 1, recycle = FALSE) {
    if (!all(is.element(c("stats", "range"), names(warjack)))) {
        stop("missing elements in warjack object") }
    if (!is.element(c("melee"), names(warjack))) {
        warjack$melee <- list() }
    if (!is.element(c("special"), names(warjack))) {
        warjack$special <- character() }
    if (!is.element(c("melee"), names(target))) {
        target$melee <- list() }
    if (!is.element(c("special"), names(target))) {
        target$special <- character() }
    nd <- length(dist)
    damage <- rep(0, nd)
    short <- rep(0, nd)
    hit_roll <- FALSE
    hit <- rep(FALSE, nd)
    miss <- rep(FALSE, nd)
    if (length(pos) != 1) {
        if (length(pos) != nd) { stop("pos should be length one or length dist") }
    } else { pos <- rep(pos, times = nd) }
    if (length(foc) != 1) {
        if (length(foc) != nd) { stop("foc should be length one or length dist") }
    } else { foc <- rep(foc, times = nd) }
    if (length(kd) != 1) {
        if (length(kd) != nd) { stop("kd should be length one or length dist") }
    } else { kd <- rep(kd, times = nd) }
    wjs <- warjack$range[[which]]$special
    wjp <- warjack$range[[which]]$stats["POW"]
    wjr <- warjack$range[[which]]$stats["RNG"]
    miss[wjr < dist] <- TRUE
    short[wjr < dist] <- c(dist - wjr)[wjr < dist]
    miss["stealth" %in% target$special & dist > 5] <- TRUE
    isEng <- is.engaged(warjack, target, dist = dist, kd = kd)
    isEng["gunfighter" %in% warjack$ranged[[which]]$special & dist <= 0.5] <- FALSE
    for (ds in seq_len(nd)) {
        num_dice_hit <- 2
        num_dice_dam <- 2
        if (!isEng[ds]) {
            if (!miss[ds]) {
                # boost hit if able
                if (boost_hit & foc[ds] > 0) {
                    num_dice_hit <- num_dice_hit + 1
                    foc[ds] <- foc[ds] - 1 }
                hit_roll <- dice[seq.int(from = pos[ds], to = pos[ds] + num_dice_hit - 1)]
                if (any(is.na(hit_roll))) { stop("insufficient dice for hit_roll") }
                pos[ds] <- pos[ds] + num_dice_hit
                hit[ds] <- unname(((sum(hit_roll, warjack$stats["RAT"]) >= target$stats["DEF"] &
                    !all(hit_roll < 2)) | all(hit_roll > 5)))
            }
            if (!hit[ds]) {
                scatter_roll <- dice[seq.int(from = pos[ds], to = pos[ds] + 1)]
                if (any(is.na(scatter_roll))) { stop("insufficient dice for scatter_roll") }
                hit[ds] <- is.scatter.hit(warjack$range[[which]],
                    short = short[ds],
                    base = target$stats["BASE"], max = min(wjr, dist[ds]) / 2,
                    dice = scatter_roll)
                pos[ds] <- pos[ds] + 2
                miss[ds] <- TRUE
            }
            # cause damage when hit
            if (hit[ds]) {
                # only boost damage roll when hit
                if (boost_damage & foc[ds] > 0) {
                    num_dice_dam <- num_dice_dam + 1
                    foc[ds] <- foc[ds] - 1
                }
                # check for critical effect
                if (!is.logical(hit_roll) & sum(duplicated(hit_roll)) > 0) {
                    if ("critical knockdown" %in% wjs) { kd[ds] <- TRUE }
                    if ("critical devastation" %in% wjs) {
                        if (target$stats["BASE"] < 120) {
                            dist[ds] <- dist[ds] + dice[pos[ds]]
                            pos[ds] <- pos[ds] + 1
                            kd[ds] <- TRUE
                        }
                    }
                }
                damage_roll <- dice[seq.int(from = pos[ds], to = pos[ds] + num_dice_dam - 1)]
                if (any(is.na(damage_roll))) { stop("insufficient dice for damage_roll") }
                pos[ds] <- pos[ds] + num_dice_dam
                if (!recycle & ds < nd) { pos[ds + 1] <- pos[ds] }
                pow <- wjp
                # if not direct hit, divide POW by 2, rounding up
                if (miss[ds]) { pow <- ceiling(wjp / 2) }
                damage[ds] <- unname(pow +
                    sum(damage_roll) - target$stats["ARM"])
            }
        }
    }
    damage[damage < 0] <- 0
    return(cbind('damage' = damage, 'focus' = foc, 'knocked down' = kd,
            'position' = pos, 'hit' = hit, 'dist' = dist)[seq_len(nd), , drop = TRUE])
}

I wouldn’t expect you to believe me without unit tests.

> tests <- vector(mode = "logical", length = 15)
>
> # TEST 1: no focus, all sixes
> test1 <- shot(destroyer, which = 1, target = list(stats = c(DEF = 20, ARM = 0)),
+     boost_hit = FALSE, boost_damage = TRUE, foc = 0, kd = FALSE, dice = rep(6, 4))
> tests[1] <- all(test1 == c(damage = 26, focus = 0, "knocked down" = 0, position = 5, hit = 1, dist = 6))
>
> # TEST 2: no focus DEF 16
> test2 <- shot(destroyer, which = 1, target = list(stats = c(DEF = 20, ARM = 0, BASE = 10)), dist = 14,
+     boost_hit = FALSE, boost_damage = TRUE, foc = 0, kd = FALSE, dice = c(6, 5, 6, 5))
> tests[2] <- all(test2 == c(damage = 0, focus = 0, "knocked down" = 0, position = 5, hit = 0, dist = 14))
>
> # TEST 3: no focus DEF 16, lucky scatter
> test3 <- shot(destroyer, which = 1, target = list(stats = c(DEF = 20, ARM = 0, BASE = 50)), dist = 6,
+     boost_hit = FALSE, boost_damage = TRUE, foc = 0, kd = FALSE, dice = c(1, 3, 1, 1, 1, 1))
> tests[3] <- all(test3 == c(damage = 9, focus = 0, "knocked down" = 0, position = 7, hit = 1, dist = 6))
>
> # TEST 4: no focus short, lucky scatter
> test4 <- shot(destroyer, which = 1, target = list(stats = c(DEF = 0, ARM = 0, BASE = 50)), dist = 14.5,
+     boost_hit = TRUE, boost_damage = FALSE, foc = 3, kd = FALSE, dice = c(1, 5, 1, 1))
> tests[4] <- all(test4 == c(damage = 9, focus = 3, "knocked down" = 0, position = 5, hit = 1, dist = 14.5))
>
> # TEST 5: no focus short, long lucky scatter (6" to 1)
> test5 <- shot(destroyer, which = 1, target = list(stats = c(DEF = 0, ARM = 0, BASE = 50)), dist = 21,
+     boost_hit = FALSE, boost_damage = TRUE, foc = 0, kd = FALSE, dice = c(6, 1, 1, 1))
> tests[5] <- all(test5 == c(damage = 9, focus = 0, "knocked down" = 0, position = 5, hit = 1, dist = 21))
>
> # TEST 6: boost blast damage
> test6 <- shot(destroyer, which = 1, target = list(stats = c(DEF = 0, ARM = 13, BASE = 30)), dist = 14.5,
+     boost_hit = TRUE, boost_damage = TRUE, foc = 1, kd = FALSE, dice = c(1, 2, 1, 2, 4))
> tests[6] <- all(test6 == c(damage = 1, focus = 0, "knocked down" = 0, position = 6, hit = 1, dist = 14.5))
>
> # TEST 7: stealth
> test7 <- shot(destroyer, which = 1, target = list(stats = c(DEF = 0, ARM = 13, BASE = 30), special = "stealth"), dist = 6,
+     boost_hit = TRUE, boost_damage = TRUE, foc = 3, kd = FALSE, dice = c(1, 2, 1, 2, 4))
> tests[7] <- all(test7 == c(damage = 1, focus = 2, "knocked down" = 0, position = 6, hit = 1, dist = 6))
>
> # TEST 8: in melee
> test8 <- shot(destroyer, which = 1, target = list(stats = c(DEF = 0, ARM = 13, BASE = 30)), dist = 0.5,
+     boost_hit = TRUE, boost_damage = TRUE, foc = 3, kd = FALSE, dice = c())
> tests[8] <- all(test8 == c(damage = 0, focus = 3, "knocked down" = 0, position = 1, hit = 0, dist = 0.5))
>
> # TEST 9: in melee engaging
> test9 <- shot(behemoth, which = 2,
+     target = list(stats = c(DEF = 0, ARM = 13, BASE = 30), melee = list('doom hammer' = list(stats = c('RNG' = 2)))),
+     dist = 2,
+     boost_hit = TRUE, boost_damage = TRUE, foc = 3, kd = FALSE, dice = c())
> tests[9] <- all(test9 == c(damage = 0, focus = 3, "knocked down" = 0, position = 1, hit = 0, dist = 2))
>
> # TEST 10: knocked down
> test10 <- shot(conquest, which = 3, target = scythean, dist = 0.5,
+     boost_hit = TRUE, boost_damage = FALSE, foc = 3, kd = TRUE, dice = rep(6, 5))
> tests[10] <- all(test10 == c(damage = 6, focus = 2, "knocked down" = 1, position = 6, hit = 1, dist = 0.5))
>
> # TEST 11: no focus, all sixes range 3:5
> test11 <- shot(destroyer, which = 1, target = list(stats = c(DEF = 20, ARM = 0)),
+     boost_hit = FALSE, boost_damage = TRUE, foc = 0, dist = 3:5, kd = FALSE, dice = rep(6, 4 * 3))
> tests[11] <- all(test11 == cbind(damage = 26, focus = 0, "knocked down" = 0, position = c(5, 9, 13), hit = 1, dist = 3:5))
>
> # TEST 12: no focus DEF 7, stealth, lucky scatter, range 4:6
> test12 <- shot(destroyer, which = 1, target = list(stats = c(DEF = 7, ARM = 0, BASE = 30), special = "stealth"), dist = 4:6,
+     boost_hit = TRUE, boost_damage = FALSE, foc = 0, kd = FALSE, dice = c(1, 3, 1, 1, 1, 1), recycle = TRUE)
> tests[12] <- all(test12 == cbind(damage = c(16, 16, 9), focus = 0, "knocked down" = 0, position = 5, hit = 1, dist = 4:6))
>
> # TEST 13: 3 focus, all fives range c(1, 6, 11, 16)
> test13 <- shot(destroyer, which = 1, target = list(stats = c(DEF = 13, ARM = 13, BASE = 30), melee = list(Halberd = list(stats = c(RNG = 2)))),
+     boost_hit = TRUE, boost_damage = TRUE, foc = 3, dist = c(1, 6, 11, 16), kd = FALSE, dice = rep(5, 4 * 6), recycle = TRUE)
> tests[13] <- all(test13 == cbind(damage = c(0, 16, 16, 0),
+         focus = c(3, 1, 1, 3), "knocked down" = 0,
+         position = c(1, 7, 7, 3),
+         hit = c(0, 1, 1, 0), dist = c(1, 6, 11, 16)))
>
> # TEST 14:  no focus short, long lucky scatter (6" to 1)
> test14 <- shot(destroyer, which = 1, target = ironclad, dist = 21,
+     boost_hit = TRUE, boost_damage = TRUE, foc = 3, kd = FALSE, dice = c(6, 1, 6, 6, 6))
> tests[14] <- all(test14 == c(damage = 7, focus = 2, "knocked down" = 0, position = 6, hit = 1, dist = 21))
>
> # TEST 15: short and long range hits
> test15 <- shot(destroyer, which = 1, target = ironclad,
+         boost_hit = TRUE, boost_damage = TRUE, foc = 3,
+         dist = c(1, 20), kd = FALSE, dice = c(4, 3, 2, 3, 4, 4, 6, 1, 6, 6, 6), recycle = FALSE)
> tests[15] <- all(test15 == cbind(damage = 7, focus = 1:2, "knocked down" = 0, position = c(7, 12), hit = 1, dist = c(1, 20)))
>
> if (all(tests)) { cat("shot is okay\n") } else { cat(sum(!tests), "known problem(s)\n") }
shot is okay

So far so good. We now have a utility that lets us shoot warjacks from across the table. This plot is for 10000 simulations.

> d1 <- seq(0, 20, by = 0.1)
> nn <- 1e4
>
> out <- matrix(NA, nrow = nn, ncol = length(d1))
> system.time(for (i in seq_len(nn)) {
+     dice <- sample(1:6, size = length(d1) * 10, replace = TRUE)
+     out[i, ] <- shot(destroyer, which = 1, target = ironclad,
+         boost_hit = TRUE, boost_damage = TRUE, foc = 3,
+         dist = d1, kd = FALSE, dice = dice, recycle = FALSE)[, "damage", drop = TRUE]
+ })
   user  system elapsed
 148.11    0.11  150.72
>
> p1 <- c(0, 0.1, 0.25, 0.4, 0.6, 0.75, 0.9, 1)
> np1 <- length(p1)
> qout <- apply(out, 2, quantile, probs = p1)
>
> plot(range(d1), range(qout), type = "n",
+     xlab="Distance (inches)",
+     ylab="Damage")
> abline(v = seq(0, 20, by = 0.5), col = "lightgrey", lty = 2)
> for (i in seq_len(floor(np1 / 2))) {
+
+  polygon(c(d1, rev(d1)), c(qout[i, ],
+    rev(qout[np1 - (i - 1), ])), col = "#CC223333", border = NA)
+
+ }

Image

Choosing some of these numbers:

> rownames(qout) <- p1
> colnames(qout) <- d1
> qout[, c("0", "1", "6", "11", "16", "21")]
     0  1  6 11 16 21
0    0  0  0  0  0  0
0.1  0  0  0  0  0  0
0.25 0  3  0  0  0  0
0.4  0  5  4  3  0  0
0.6  0  7  6  6  0  0
0.75 0  8  8  8  0  0
0.9  0 10 10 10  0  0
1    0 14 14 14  7  7

So when a Destroyer shoots an Ironclad eleven inches away, 25% of the time it is going to do at least 8 damage, and at 21 inches it has at least a 90% chance  of doing nothing (it needs to scatter onto the target, and is only inflicting blast damage.

But the interesting feature here is that ranged weapons with an area of effect can be expected to do more damage on average than ranged weapons without an area of effect. This is because a miss at close range cannot scatter further than half the distance between the target and the attacker. Although this is obvious when pointed out, I was not expecting to see this in the plot!

This function does not handle attackers with sprays. I’ll probably implement that separately. But here it this to play with. A systematic study of the effect of ranged attacks will let us decide whether a ranged warjack a given distance from a target should shoot or engage in some other way. Perhaps additional interesting features of this system will come to light.

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s