Merge pull request #3 from Rucknium/main

New feature to display potential inter-building production influence for each building type

DESCRIPTION

@@ -1,8 +1,10 @@
 Package: TownforgeR
 Title: R-package for handling Townforge related data
-Version: 0.0.11
-Authors@R: person("Teemu Daniel", "Laajala", email = "teelaa@utu.fi",
-		role = c("aut", "cre"))
+Version: 0.0.12
+Authors@R: c(person("Teemu Daniel", "Laajala", email = "teelaa@utu.fi",
+		role = c("aut", "cre")),
+		person(given = "Rucknium", email = "Rucknium@protonmail.com",
+		role = c("aut")) )
 Description: R-package for handling e.g. RPC interaction with the blockchain-based game Townforge, originally forked from Monero. 
 	Contains a self-sufficient R Shiny web interface for user convenience. 
 	Regarding Townforge, see further info at: www.townforge.net
@@ -17,4 +19,6 @@ Imports:
 	shiny,
 	DT,
 	bslib,
-	thematic
+	thematic,
+	readr,
+	Cairo

NAMESPACE

@@ -1,12 +1,18 @@
 # Generated by roxygen2: do not edit by hand
 
 export(shinyTF)
+export(tf_flag_bounds)
+export(tf_infl_grid)
+export(tf_infl_location)
+export(tf_influence_effects)
 export(tf_parse_accounts)
 export(tf_parse_items)
 export(tf_parse_markets)
 export(tf_parse_network)
 export(tf_parse_nft_png)
 export(tf_parse_nfts)
+export(tf_plot_influence)
 export(tf_rpc_curl)
 export(tf_shiny_item_info)
 export(tf_shiny_nft_png)
+import(Matrix)

R/extract-game-mechanics.R

@@ -0,0 +1,66 @@
+#' Construct influence effects matrix data from Townforge C++ file
+#'
+#' Description
+#'
+#' @param source.dir directory of Townforge source
+#' @param ... TODO
+#'
+#' @details Construct influence effects matrix
+#'
+#' @export
+tf_influence_effects <- function(source.dir = "https://git.townforge.net/townforge/townforge/raw/branch/cc", ...) {
+
+  source.dir <- gsub("/+$", "", source.dir)
+
+  cc_influence.v <- readLines(paste0(source.dir, "/src/cc/cc_influence.cpp"))
+
+  start.influence_rules <- grep("static const Rules influence_rules[NUM_ROLES]", cc_influence.v, fixed = TRUE)
+  dimnames.influence_rules <- cc_influence.v[ - (1:start.influence_rules) ]
+  dimnames.influence_rules <- dimnames.influence_rules[nchar(gsub(" ", "", dimnames.influence_rules)) > 20][1]
+  dimnames.influence_rules <- gsub(" *// +", "", dimnames.influence_rules)
+  dimnames.influence_rules <- gsub(" +", " ", dimnames.influence_rules)
+  dimnames.influence_rules <- unlist(strsplit(dimnames.influence_rules, " "))
+  dimnames.influence_rules <- c("EMPTY", dimnames.influence_rules)
+
+  cc_influence.v <- cc_influence.v[gsub(" ", "", cc_influence.v) != "" & 
+                                     ! grepl("^ *//", cc_influence.v)]
+  # Remove all empty lines. //// removes the "//" comments
+
+  start.influence_rules <- grep("static const Rules influence_rules[NUM_ROLES]", cc_influence.v, fixed = TRUE)
+
+  end.influence_rules <- which(gsub(" ", "", cc_influence.v) == "};")
+  end.influence_rules <- min(end.influence_rules[end.influence_rules > start.influence_rules])
+  cc_influence.v <- cc_influence.v[start.influence_rules:end.influence_rules][-1]
+  cc_influence.v <- cc_influence.v[nchar(cc_influence.v) > 20]
+
+  cc_influence.txt <- tempfile()
+  cat(file = cc_influence.txt, cc_influence.v, sep = "\n")
+  cc_infl.mat <- suppressMessages(suppressWarnings(readr::read_fwf(cc_influence.txt, readr::fwf_empty(cc_influence.txt))))
+  unlink(cc_influence.txt)
+  cc_infl.mat <- as.matrix(cc_infl.mat)
+  # attr(cc_infl.mat, "spec") <- NULL # get rid of tibble attributes
+  cc_infl.mat <- cc_infl.mat[, (-1) * c(1, ncol(cc_infl.mat))]
+  cc_infl.mat <- apply(cc_infl.mat, 2, FUN = function(x) {
+    gsub("[{},]", "", x)
+  })
+  cc_infl.mat <- rbind("0", cc_infl.mat)
+  # Need an extra first row for EMPTY
+
+  dimnames(cc_infl.mat) <- list(dimnames.influence_rules, dimnames.influence_rules)
+
+  extract.influence <- function(x, type, dimnames) {
+    ret <- apply(x, 2, FUN = function(y) {
+      y <- stringr::str_extract(y, paste0(type, "[(][0-9]+[)]"))
+      as.numeric(gsub("[()]", "", stringr::str_extract(y, "[(][0-9]+[)]")))
+    })
+    dimnames(ret) <- list(dimnames, dimnames)
+    ret
+  }
+
+  bonus.infl.mat <- extract.influence(cc_infl.mat, "BONUS", dimnames.influence_rules)
+  need.infl.mat <- extract.influence(cc_infl.mat, "NEED", dimnames.influence_rules)
+  penalty.infl.mat <- extract.influence(cc_infl.mat, "PENALTY", dimnames.influence_rules)
+
+  list(bonus = bonus.infl.mat, need = need.infl.mat, penalty = penalty.infl.mat)
+
+}