Created
July 17, 2018 01:52
-
-
Save oganm/5a736801ee8f5a9472e5cd2c516a34aa to your computer and use it in GitHub Desktop.
compile chars backup
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(import5eChar) | |
library(purrr) | |
library(ogbox) | |
library(dplyr) | |
library(ggplot2) | |
library(stringr) | |
library(igraph) | |
library(glue) | |
library(cowplot) | |
charFiles = c(list.files('/srv/shiny-server/printSheetApp/chars/',full.names = TRUE), | |
list.files('/srv/shiny-server/interactiveSheet/chars/',full.names = TRUE), | |
list.files('/srv/shiny-server/chars',full.names = TRUE), | |
list.files('/srv/shiny-server/chars2', full.names = TRUE), | |
list.files('/srv/shiny-server/chars3', full.names = TRUE), | |
list.files('/srv/shiny-server/chars4', full.names = TRUE)) | |
chars = charFiles %>% lapply(function(x){ | |
importCharacter(file = x) | |
}) | |
fileInfo = file.info(charFiles) | |
fileData = charFiles %>% basename %>% strsplit('_') | |
chars = lapply(1:length(chars),function(i){ | |
char = chars[[i]] | |
char$date = fileInfo$mtime[i] | |
if(length(fileData[[i]]) == 1){ | |
char$ip = 'NULL' | |
char$finger = 'NULL' | |
char$hash = fileData[[i]] | |
} else{ | |
char$finger = fileData[[i]][1] | |
char$ip = fileData[[i]][2] | |
char$hash = fileData[[i]][3] | |
} | |
char | |
}) | |
names(chars) = chars %>% map_chr(function(x){ | |
paste(x$Name,x$ClassField) | |
}) | |
charTable = chars %>% map(function(x){ | |
data.frame(ip = x$ip, | |
finger = x$finger, | |
hash = x$hash, | |
name = x$Name, | |
race = x$Race, | |
date = x$date, | |
class = paste(x$classInfo[,1],x$classInfo[,3],collapse=', '), | |
justClass = x$classInfo[,'Class'] %>% paste(collapse =', '), | |
subclass = x$classInfo[,'Archetype'] %>% paste(collapse =', '), | |
level = x$classInfo[,'Level'] %>% as.integer() %>% sum, | |
day = x$date %>% format('%m %d'), | |
stringsAsFactors = FALSE) | |
}) %>% do.call(rbind,.) | |
charTable$date %>% table %>% sort | |
charTable$date[!as.Date(charTable$date) > as.Date('2018-04-16')] | |
charTable %>% filter(as.Date(date) > as.Date('2018-04-16')) %$% date %>% weekdays() %>% table %>% sort %>% plot | |
# user = list(dummy = list(ip = 'hede', | |
# finger = 'hede', | |
# hash = 'hede', | |
# char = 'hede', | |
# fellows = 1)) | |
# | |
# for(i in seq_len(nrow(charTable))){ | |
# userIPs = user %>% map('ip') | |
# userFingers = user %>% map('finger') | |
# userHashes = user %>% map('hash') | |
# userChars = user %>% map('char') | |
# userFellows = user %>% map('fellows') | |
# | |
# ipMatches = findInList(charTable$ip[i], userIPs) | |
# fingerMatches =findInList(charTable$finger[i], userFingers) | |
# hashMatches =findInList(charTable$hash[i], userHashes) | |
# charMatches =findInList(paste(charTable$name[i],gsub(' [0-9]+','',charTable$class[i])), userChars) | |
# | |
# | |
# | |
# } | |
charTable %>% filter(justClass == "Fighter") %>% arrange(desc(level))%>% {.[!duplicated(.$name),]} %$%subclass %>% table %>% sort %>% as.df %>% | |
ggplot(aes(x =.,y= Freq)) + geom_bar(stat ='identity') + theme(axis.text.x = element_text(angle=90,vjust = .5,hjust =1)) | |
charCounts = chars %>% map_chr(function(x){ | |
paste(x$Name,x$ClassField) | |
}) %>% duplicated %>% {chars[!.]} %>% map_chr('ClassField') %>% gsub(x = .,pattern = ' [0-9]+',replacement = '') %>% | |
{data.frame(names(.), .)} %>% unique %$% . %>% table %>% sort | |
# uniqueChars = chars %>% map_chr(function(x){ | |
# paste(x$Name,x$ClassField) %>% gsub | |
# }) %>% unique %>% sort | |
charCounts %>% as.df %>% filter(Freq>=20) %>% ggplot(aes(x =.,y= Freq)) + geom_bar(stat ='identity') + theme(axis.text.x = element_text(angle=90,vjust = .5,hjust =1)) | |
sum(charCounts)/as.integer(Sys.Date() - as.Date('2018-04-06')) | |
# char stats | |
secureTable = charTable | |
secureTable$ip %<>% sapply(function(x){ | |
if(x %in% c('','NULL')){ | |
return('') | |
} else{ | |
digest(x,'sha1') | |
} | |
}) | |
secureTable$name %<>% sapply(digest,'sha1') | |
uniqueTable = charTable %>% arrange(desc(level)) %>% {.[!duplicated(paste(.$name,.$justClass)),]} | |
charCounts = uniqueTable$justClass %>% table %>% sort | |
# fivethirtyeight re-create | |
races = uniqueTable$race %>% unique | |
races = c(Aarakocra = 'Aarakocra', | |
Aasimar = 'Aasimar', | |
Bugbear= 'Bugbear', | |
Dragonborn = 'Dragonborn', | |
Dwarf = 'Dwarf', | |
Elf = '(?<!Half-)Elf', | |
Firbolg = 'Firbolg', | |
Genasi= 'Genasi', | |
Gith = 'Geth', | |
Gnome = 'Gnome', | |
Goblin='Goblin', | |
Goliath = 'Goliath', | |
'Half-Elf' = '(Half-Elf)|(Variant)', | |
'Half-Orc' = 'Half-Orc', | |
Halfling = 'Halfling', | |
Hobgoblin = 'Hobgoblin', | |
Human = 'Human', | |
Kenku = 'Kenku', | |
Kobold = 'Kobold', | |
Lizardfolk = 'Lizardfolk', | |
Orc = '(?<!Half-)Orc', | |
'Yaun-Ti' = 'Serpentblood', | |
Tabaxi = 'Tabaxi', | |
Tiefling ='Tiefling|Lineage', | |
Triton = 'Triton', | |
Turtle = 'Turtle|Tortle') | |
uniqueTable$justClass %<>% gsub(pattern = 'Revised ', replacement = '',x = .) | |
uniqueTable$class %<>% gsub(pattern = 'Revised ', replacement = '',x = .) | |
classes = uniqueTable$justClass %>% str_split(', ') %>% unlist %>% unique | |
coOccurenceMatrix = matrix(0 , nrow=length(races),ncol = length(classes)) | |
colnames(coOccurenceMatrix) = classes | |
rownames(coOccurenceMatrix) = names(races) | |
for (i in seq_along(races)){ | |
for (j in seq_along(classes)){ | |
((grepl(races[i],uniqueTable$race,perl= TRUE)) * { | |
classLevel =str_extract(uniqueTable$class,glue('(?<={classes[j]} )[0-9]+')) %>% {.[is.na(.)] = 0;.} %>% as.integer() | |
classLevel/uniqueTable$level | |
}) %>% sum -> coOcc | |
coOccurenceMatrix[i,j] = coOcc | |
} | |
} | |
coOccurenceMatrixSubset = coOccurenceMatrix[,!coOccurenceMatrix %>% apply(2,sum) %>% {.<2}] | |
coOccurenceMatrixSubset = coOccurenceMatrixSubset[!coOccurenceMatrixSubset %>% apply(1,sum) %>% {.<2},] | |
coOccurenceMatrixSubset = | |
coOccurenceMatrixSubset[coOccurenceMatrixSubset %>% apply(1,sum) %>% order(decreasing = FALSE), | |
coOccurenceMatrixSubset %>% apply(2,sum) %>% order(decreasing = TRUE)] | |
coOccurenceMatrixSubset %>% reshape2::melt() %>% ggplot(aes(x = Var2,y = Var1)) + | |
geom_tile(aes(fill = value))+ | |
scale_fill_continuous(low = 'white',high = '#46A948')+ | |
# viridis::scale_fill_viridis() + | |
geom_text(aes(label = value %>% round(2) %>% format(nsmall=2))) + | |
scale_x_discrete(position='top') + xlab('') + ylab('') | |
# multiclassing network | |
coOccurence = uniqueTable$justClass %>% grepl(',',.) %>% {uniqueTable$justClass[.]} %>% gsub(pattern = 'Revised ', replacement = '',x = .) | |
uniqueClasses = coOccurence %>% strsplit(', ') %>% unlist %>% unique | |
adjMatrix = matrix(0,nrow= length(uniqueClasses),ncol = length(uniqueClasses)) | |
for (i in seq_along(uniqueClasses)){ | |
for(j in seq_along(uniqueClasses)){ | |
if(i !=j){ | |
adjMatrix[i,j] = sum(grepl(x = coOccurence,pattern = uniqueClasses[i]) & grepl(x = coOccurence,pattern = uniqueClasses[j])) | |
} | |
} | |
} | |
rownames(adjMatrix) = uniqueClasses | |
colnames(adjMatrix) = uniqueClasses | |
network=graph_from_adjacency_matrix( adjMatrix, weighted=T, mode="undirected", diag=F) | |
E(network)$width <- E(network)$weight | |
plot(network,layout = layout_as_star, | |
vertex.frame.color="white", | |
vertex.label.color="black", | |
vertex.size = strength(network) | |
) | |
# normalize network strength by class popularity | |
adjMatrix = matrix(0,nrow= length(uniqueClasses),ncol = length(uniqueClasses)) | |
for (i in seq_along(uniqueClasses)){ | |
for(j in seq_along(uniqueClasses)){ | |
if(i !=j){ | |
adjMatrix[i,j] = sum(grepl(x = coOccurence,pattern = uniqueClasses[i]) & grepl(x = coOccurence,pattern = uniqueClasses[j]))/ | |
(sum(coOccurenceMatrix[,uniqueClasses[i]]) + sum(coOccurenceMatrix[,uniqueClasses[j]])) | |
} | |
} | |
} | |
rownames(adjMatrix) = uniqueClasses | |
colnames(adjMatrix) = uniqueClasses | |
network=graph_from_adjacency_matrix( adjMatrix, weighted=T, mode="undirected", diag=F) | |
E(network)$width <- E(network)$weight*100 | |
plot(network,layout = layout_as_star, | |
vertex.frame.color="white", | |
vertex.label.color="black", | |
vertex.size = strength(network)*100 | |
) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment