YGO Deck Tool 2016/10/02

setwd("~/R/Projects/Deck Tester")

## DECK TOOL rev. 2016/10/02 ================================================
#
# This tool performs several functions that assist deck-building in trading
# card games.  I developed this tool to reduce deck-building time and improve
# the accuracy and efficiency of play-testing,  This tool is also
# significantly more accurate efficient than sampling randomly drawn hands,
# because it bases calculations on all possible hands.
#
# 1. GENERATE ALL POSSIBLE UNIQUE HANDS: This is useful for learning a new
#     deck and determining what kind of hands are playable.
#
# 2. CALCULATE PERCENTAGE OF HANDS THAT MEET CRITERIA: This is useful for
#     measuring combo consistency and refining card ratios.
#
# To use this tool, please place the R script in the same directory as the
# deck list you want to use it with and set working directory to the source
# file location.  For best results, your deck list should be a *.txt file,
# and it should only contain cards in the deck that you draw from at the
# beginning of the game.  Each line of the *.txt file should be formatted as
# 'quantity [tab] # card name,' like so:
#
#     3     Cardcar D
#
# If any cards in your deck have any characteristics (level, attribute, card
# type, etc.) that you would like to test for, append them to the card name
# using abbreviations that are identifiable to you, but are not a part of any
# other card names (e.g. [4] for Level 4, [r] for Ritual, etc.).
#
# To perform a criteria test, create a vector of abbreviations or names for
# desired cards and assign it to the 'crit' argument in the function call. A
# criteria test can be performed without generating readable hands.
#
# To produce readable hands, set the 'hgen' argument to TRUE.  The output
# will include all unique hands or, if a criteria test is performed, only
# hands that meet the tested criteria.  For your future reference, the
# function will produce a *.txt file containing the same hands.  The number
# at the beginning of each line indicates how many times that hand repeats.
#
# To further meet your testing needs, you can adjust the number of cards to
# draw in each hand by assigning a new number to the 'draw' arugment.  The
# default is 5, which is the number of starting cards in Yu-Gi-Oh!  Please
# be aware that increasing the number of cards drawn may significantly
# increase function run time.
#
# If your deck contains a draw-one effect, such as 'Upstart Goblin' from
# Yu-Gi-Oh!, and you would like to immediately resolve it in each hand it's
# drawn, assign the 'upst' argument with its name.  If you don't have or
# don't want to resolve these effects, leave the 'upst' argument blank by
# assigning '' to it instead.  Resoling effects that draw more than one card
# is currently not yet implemented.

deck <- function(dtxt, crit = c(),
                 draw = 5, upst = 'Upstart Goblin', hgen = F) {
  # dtxt:   *.txt file of deck list or previous output from deck()
  # crit:   string vector of criteria to evaluate for each hand
  # hgen:   generate readable output of unique hands
  # draw:   draw additional card for going second
  # upst:   immediately resolve draw-one effect, e.g. 'Upstart Goblin'
# HELPER FUNCTIONS ----------------------------------------------------------
  d_check <- function(deck) {
    # deck:   main input arg
    if (is.character(deck)) {
      d_out <- read.delim(deck, header = F, stringsAsFactors = F)
    } else if (is.data.frame(deck)) {
      if (is.numeric(deck$V1) & is.factor(deck$V2)) {
        d_out <- deck
      } else {
        stop('Input data frame is malformed.')
      }
    } else if (is.list(deck) & is.data.frame(deck[[1]])) {
      if (is.numeric(deck[[1]]$V1) & is.factor(deck[[1]]$V2)) {
        d_out <- deck[[1]]
      } else {
        stop('Input list is malformed.')
      }
    } else {
      stop('Deck file must be *.txt, data frame, or list.')
    }
    d_size <- sum(d_out$V1)
    if (d_size < 40 | d_size > 60 | any(d_out$V1 > 3)) {
      stop('Deck must contain 40 to 60 cards, 3 copies per card or fewer.')
    } else {
      print(paste('Read deck containing', d_size, 'total cards.'))
    }
    return(d_out)
  } # check deck validity
  d_upst <- function(deck, upst) {
    # deck:   data frame from d_check()
    # upst:   main input arg
    upst_idx <- grepl(upst, deck$V2, fixed = T)
    if (any(upst_idx)) {
      deck <- deck[!upst_idx, ]
      print('Resolved \'Upstart Goblin\'.')
    } else {
      print('Deck does not contain \'Upstart Goblin\'.')
    }
    return(deck)
  } # resolve 'Upstart Goblin'
  d_c <- function(deck, crit) {
    # deck:   data frame from d_check(), d_upst()
    # crit:   main input arg
    p_idx <- rep(F, nrow(deck))
    for (i in 1:length(crit)) {
      p_idx[grep(crit[i], deck$V2, fixed = T)] <- T
    }
    deck$V2[!p_idx] <- NA
    print('Deck pre-filtered for criteria.')
    return(deck)
  } # filter deck for criteria
  d_h <- function(deck, draw) {
    # deck:   data frame from d_check(), d_upst(), or d_c()
    # draw:   main input arg
    h_all <- t(combn(rep(deck$V2, deck$V1), draw))
    h_flat <- apply(h_all, 1, paste, collapse = '')
    h_rep <- duplicated(h_flat)
    h_uid <- 1:nrow(h_all)
    h_uid[h_rep] <- match(h_flat[h_rep], h_flat)
    print(paste('Generated', sum(!h_rep), 'unique hands.'))
    return(list(unique.matrix(h_all), table(h_uid)))
  } # create unique hands and repetitions
  h_eval <- function(hand, crit) {
    # hand:   vector of cards in hand
    # crit:   vector of criteria for hand
    p_ct <- 0
    for (i in 1:length(crit)) {
      if (any(grepl(crit[i], hand, fixed = T))) {
        p_idx <- grep(crit[i], hand, fixed = T)[1]
        hand <- hand[-p_idx]
        p_ct <- p_ct + 1
      }
    }
    if (p_ct == length(crit)) return(T) else return(F)
  } # check hand for criteria
  h_write <- function(hands, reps, dtxt) {
    # hands:  matrix of unique hands from d_h()[[2]]
    # reps:   vector of repetitions from d_h()[[3]]
    # dtxt:   main input arg
    if (is.character(dtxt)) {
      h_out <- paste(sub('.[a-z]+$', '', dtxt), '_hand.txt', sep = '')
    } else {
      h_out <- paste(deparse(substitute(dtxt)), '_hand.txt', sep = '')
    }
    write.table(cbind(reps, hands), h_out, col.names = F, row.names = F)
    print(paste(sep = '', 'Hands printed to \'', h_out, '\'.'))
  } # write unique hands to *.txt
# FUNCTION DEFINTION --------------------------------------------------------
  d_out <- d_check(dtxt)
  if (!hgen & !length(crit)) {
    return(d_out)
  } else {
    d_gen <- if (length(upst)) d_upst(d_out) else d_out
    d_uniq <- if (hgen) d_h(d_gen, draw) else d_h(d_c(d_gen, crit), draw)
    u_hand <- d_uniq[[1]]
    u_rp <- d_uniq[[2]]
    if (!length(crit)) {
      h_write(u_hand, u_rp, dtxt)
      return(list(d_out, u_hand, u_rp))
    } else {
      c_ct <- nrow(u_hand)
      p_key <- rep(F, c_ct)
      print('Evaluating unique hands...')
      for (i in 1:c_ct) {
        p_key[i] <- h_eval(u_hand[i, ], crit)
        print(paste(i, 'of', c_ct, ifelse(p_key[i], 'passed', 'failed')))
      }
      p_rate <- sum(u_rp[p_key])/sum(u_rp)
      print(paste(sep = '', 'Criteria met: ', round(100*p_rate, 2), '%'))
      if (hgen) h_write(u_hand[p_key, ], u_rp[p_key], dtxt)
      return(list(d_out, u_hand[p_key, ], u_rp[p_key], crit, p_rate))
    }
  }
}