compile chars backup

compileChars.R

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
)