Last active
February 18, 2016 13:24
-
-
Save lockefox/e73d1d4b28cfa103157b to your computer and use it in GitHub Desktop.
PROSPER Skill Trade/RMT Plotting script
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(RODBC) | |
library(ggplot2) | |
library(grid) | |
library(reshape) | |
library(scales) | |
library(data.table) | |
library(quantmod) | |
library(jsonlite) | |
library(cowplot) | |
library(plyr) | |
### SCRIPT GLOBALS ### | |
plot.width <- 1600 | |
plot.height <- 900 | |
date_range <- 10 | |
cutoff_date <- Sys.Date() - date_range | |
title_date <- Sys.Date() | |
chart_repo <- "C:/Users/Lockefox/Plots/" | |
chart_repo <- paste0(chart_repo,Sys.Date(),"_RMT-",date_range,"/") | |
dir.create(chart_repo, showWarnings=FALSE) | |
#EC_ODBC <- "evemarketdata" | |
EC_ODBC <- "randomboy_new" | |
SDE_ODBC <- "sde_lookup" | |
ZKB_ODBC <- "randomboy_new" | |
### PLEX/AUR CALC VALUES ### | |
ExtractorID = 40519 | |
InjectorID = 40520 | |
PLEX_ID = 29668 | |
MPCT_ID = 34133 | |
ResculptID = 34132 | |
typeID_list <- c(29668,34133,34132,40519,40520) | |
PLEX_AUR <- 3500 | |
RMT_AUR <- 4035 #$20 USD rate | |
Extractor_AUR <- 800 | |
SP_HR <- 2700 | |
SP_PLEX <- SP_HR * 30 * 24 | |
### PATCH STUFF ### | |
patch_list.full <- as.POSIXlt( c("2015-09-29 13:00", #Vanguard | |
"2015-09-15 13:00", #Galatea | |
"2015-11-03 13:00", #Parallax | |
"2015-11-24 16:00", #Black Friday PLEX sale | |
"2015-10-20 05:00", #Bloody Omir Starts | |
"2015-12-08 13:00", #Frostline | |
"2016-01-12 13:00", #YC118.1 | |
"2016-01-18 15:10", #brainmeat | |
#"2016-02-05 19:45", | |
"2016-02-09 13:00" | |
)) | |
patch_list.names <- c("Vanguard", | |
"Galatea", | |
"Parallax", | |
"Black Friday Sale", | |
"Crimson Harvest", | |
"Frostline", | |
"YC118.1", | |
"Skill Trading Devblog", | |
#"AUR Prices Released", | |
"YC118.2") | |
patch_list <- c() | |
patch_title <- c() | |
for (row in 1:NROW(patch_list.full)){ #Find the patches in the date range | |
tmpdate <- as.Date(patch_list.full[row]) | |
if (tmpdate > cutoff_date){ | |
patch_list <- c(patch_list, as.character(patch_list.full[row])) | |
patch_title <- c(patch_title, as.character(patch_list.names[row])) | |
} | |
} | |
x_intercepts <- as.POSIXlt(patch_list) | |
line_titles <- data.frame(x=patch_list, | |
y=NA, | |
label=patch_title) | |
line_titles$x <- as.POSIXlt(line_titles$x) | |
### GGPLOT THEME ### | |
theme_dark <- function( ... ) { | |
theme( | |
text = element_text(color="gray90"), | |
title = element_text(size=rel(2.5),hjust=0.05,vjust=3.5), | |
axis.title.x = element_text(size=rel(0.75),hjust=0.5, vjust=0), | |
axis.title.y = element_text(size=rel(0.75),hjust=0.5, vjust=1.5), | |
plot.margin = unit(c(2,1,1,1), "cm"), | |
plot.background=element_rect(fill="gray8",color="gray8"), | |
panel.background=element_rect(fill="gray10",color="gray10"), | |
panel.grid.major = element_line(colour="gray17"), | |
panel.grid.minor = element_line(colour="gray12"), | |
axis.line = element_line(color = "gray50"), | |
plot.title = element_text(color="gray80",size=rel(0.8)), | |
axis.title = element_text(color="gray70"), | |
axis.text = element_text(color="gray50",size=rel(1.1)), | |
legend.key = element_rect(fill="gray8",color="gray8"), | |
legend.background = element_rect(fill="gray8"), | |
legend.title = element_text(size=rel(0.6)), | |
legend.text = element_text(size=rel(1.1)), | |
strip.background = element_rect(fill="#252525"), | |
strip.text = element_text(size=rel(1.5)) | |
#strip.text.x = element_text(size=rel(1.5)) | |
) + theme(...) | |
} | |
### FETCH SQL ### | |
SDE <- odbcConnect(SDE_ODBC) | |
print("FETCHING DATA") | |
sde_q <- paste0("SELECT typeID,typeName FROM invtypes") | |
print("--fetching SDE") | |
sde_lookup <- sqlQuery(SDE,sde_q) | |
map_q <- paste0("SELECT solarsystemid,SolarSystemName FROM mapsolarsystems") | |
print("--fetching MAP") | |
map_lookup <- sqlQuery(SDE,map_q) | |
EC <- odbcConnect(EC_ODBC) | |
ec_q <- paste0("SELECT price_date AS `date`, price_time AS `hour`, locationid,", | |
"SUM(IF(buy_sell=1, price_best,0)) AS 'SellOrder', ", | |
"SUM(IF(buy_sell=1, order_volume,0)) AS 'SellVolume', ", | |
"SUM(IF(buy_sell=0, price_best,0)) AS 'BuyOrder', ", | |
"SUM(IF(buy_sell=0, order_volume,0)) AS 'BuyVolume', typeid ", | |
"FROM snapshot_evecentral ", | |
"WHERE typeid IN (", paste(typeID_list, collapse=","), ") ", | |
"AND price_date > '", cutoff_date, "' ", | |
"GROUP BY price_date, price_time, typeid, locationid") | |
print("--fetching EC Data") | |
ec_data <- sqlQuery(EC,ec_q) | |
### FORMAT DATA ### | |
print("FORMATING DATA") | |
rmt_data <- merge(ec_data, sde_lookup, by.x="typeid", by.y="typeID") #MERGE typeid/name locally | |
rmt_data <- merge(rmt_data, map_lookup, by.x="locationid", by.y="solarsystemid") | |
rmt_data$date <- as.Date(rmt_data$date) | |
rmt_data$typeid <- as.factor(rmt_data$typeid) | |
rmt_data$locationid <- as.factor(rmt_data$locationid) | |
rmt_data <- subset(rmt_data, SellOrder > 0) #remove weird zeros | |
rmt_data$datetime <- as.POSIXlt(paste(rmt_data$date, rmt_data$hour, sep=" ")) | |
rmt_data <- subset(rmt_data, !(SolarSystemName=="Hek")) | |
### RMT TOKEN MARKET ### | |
# rmt_token.tmp <- rmt_data | |
# rmt_token.tmp$SellOrder[rmt_token.tmp$typeid == ResculptID] <- PLEX_AUR/1000 * rmt_token.tmp$SellOrder[rmt_token.tmp$typeid == ResculptID] | |
# rmt_token.tmp$BuyOrder [rmt_token.tmp$typeid == ResculptID] <- PLEX_AUR/1000 * rmt_token.tmp$BuyOrder [rmt_token.tmp$typeid == ResculptID] | |
# rmt_token.tmp$SellOrder[rmt_token.tmp$typeid == ExtractorID] <- PLEX_AUR/Extractor_AUR * rmt_token.tmp$SellOrder[rmt_token.tmp$typeid == ExtractorID] | |
# rmt_token.tmp$BuyOrder [rmt_token.tmp$typeid == ExtractorID] <- PLEX_AUR/Extractor_AUR * rmt_token.tmp$BuyOrder [rmt_token.tmp$typeid == ExtractorID] | |
##TODO: GGPLOT | |
### INJECTOR MARKET ### | |
skill_trade.tmp <- rmt_data | |
skill_trade <- subset(skill_trade.tmp, typeid == InjectorID) | |
skill_trade$injector.buy <- skill_trade$BuyOrder | |
skill_trade$injector.sell <- skill_trade$SellOrder | |
skill_trade$injector.buyVol <- skill_trade$BuyVolume | |
skill_trade$injector.sellVol <- skill_trade$SellVolume | |
skill_trade.ext <- subset(skill_trade.tmp, typeid == ExtractorID) | |
skill_trade.ext$extractor.buy <- skill_trade.ext$BuyOrder | |
skill_trade.ext$extractor.sell <- skill_trade.ext$SellOrder | |
skill_trade.ext$extractor.buyVol <- skill_trade.ext$BuyVolume | |
skill_trade.ext$extractor.sellVol <- skill_trade.ext$SellVolume | |
skill_trade.plex <- subset(skill_trade.tmp, typeid == PLEX_ID) | |
skill_trade.plex$PLEX.buy <- skill_trade.plex$BuyOrder | |
skill_trade.plex$PLEX.sell <- skill_trade.plex$SellOrder | |
skill_trade.plex$PLEX.buyVol <- skill_trade.plex$BuyVolume | |
skill_trade.plex$PLEX.sellVol <- skill_trade.plex$SellVolume | |
skill_trade <- merge(skill_trade, skill_trade.ext, by=c("locationid","date","hour","datetime")) | |
skill_trade <- merge(skill_trade, skill_trade.plex, by=c("locationid","date","hour","datetime")) | |
skill_trade$isk_SP_full.buy <- skill_trade$PLEX.buy /SP_PLEX | |
skill_trade$isk_SP_full.sell <- skill_trade$PLEX.sell/SP_PLEX | |
skill_trade$isk_SP_market.buy <- (skill_trade$injector.buy - skill_trade$extractor.sell)/500000 | |
skill_trade$isk_SP_market.sell <- (skill_trade$injector.sell - skill_trade$extractor.sell)/500000 | |
alpha_group <- c(0.3, 0.3, 1, 0.3) | |
graphname <- paste0("ISK/SP Skill Injectors vs PLEX - ",title_date) | |
plot_group <- subset(skill_trade, SolarSystemName.x=="Jita") | |
plot_group.jita <- subset(plot_group, SolarSystemName.x=="Jita") | |
tics_max <- round_any(max(plot_group$isk_SP_market.sell, na.rm=TRUE), 100, f=ceiling) #round up to nearest 100 | |
tics_min <- round_any(min(plot_group$isk_SP_market.buy , na.rm=TRUE), 100, f=floor) | |
y_tics <- seq(from=tics_min, to=tics_max, by=25) | |
x_label <- max(plot_group$datetime, na.rm=TRUE) | |
y_val <- plot_group.jita$isk_SP_full.sell[plot_group.jita$datetime==max(plot_group.jita$datetime,na.rm=TRUE)] | |
lab_title <- "PLEX-SP PARITY" | |
label_df <- data.frame(x_label, y_val, lab_title) | |
label_df$x_label <- as.POSIXlt(label_df$x_label) | |
isk_SP.price <- ggplot(plot_group, aes(x=datetime, | |
ymin=isk_SP_market.buy, | |
ymax=isk_SP_market.sell, | |
#alpha=SolarSystemName.x, | |
fill=SolarSystemName.x)) | |
isk_SP.price <- isk_SP.price + geom_ribbon() + theme_dark()# + scale_alpha_manual(values = alpha_group) | |
isk_SP.price <- isk_SP.price + scale_fill_manual(values=c("Dodixie"="#00cc66", | |
"Rens"="#ff9999", | |
"Jita"="#0066ff", | |
"Amarr"="#ffff99")) | |
isk_SP.price <- isk_SP.price + scale_y_continuous(breaks=y_tics) | |
isk_SP.price <- isk_SP.price + labs(title=graphname, | |
fill="Market System", | |
x="Date", | |
y="ISK/SP") | |
isk_SP.price <- isk_SP.price + geom_line(aes(x=datetime, | |
y=isk_SP_full.sell), | |
color="white", | |
linetype=2, | |
size=1.5, | |
#label="100% PLEX value", | |
data=plot_group.jita, | |
inherit.aes=FALSE) | |
isk_SP.price <- isk_SP.price + geom_text(aes(x=x_label, | |
y=y_val, | |
label=lab_title), | |
data=label_df, | |
color="white", | |
vjust=1.25, | |
#hjust=-1.25, | |
#text=element_text(size=rel(2)), | |
inherit.aes=FALSE) | |
isk_SP.price <- isk_SP.price + geom_vline(xintercept=as.numeric(x_intercepts), | |
linetype=2, | |
color="white") | |
isk_SP.price <- isk_SP.price + geom_text(aes(x=x, | |
y=Inf, | |
label=label), | |
color="white", | |
angle=-90, | |
vjust=1.2, | |
hjust=0, | |
text=element_text(size=17), | |
data=line_titles, | |
inherit.aes=FALSE) | |
#print(isk_SP.price) | |
## PROCESS VOLUME INFORMATION ## | |
skill_trade.mod <- data.table(datetime = skill_trade$datetime, | |
SolarSystemName = skill_trade$SolarSystemName.x, | |
Injector_Sell_Volume = skill_trade$injector.sellVol, | |
Injector_Buy_Volume = skill_trade$injector.buyVol#, | |
#Extractor_Sell_volume = skill_trade$extractor.sellVol, | |
#Extractor_Buy_Volume = skill_trade$extractor.buyVol#, | |
#PLEX_Sell_Volume = skill_trade$PLEX.buyVol, | |
#PLEX_Buy_Volume = skill_trade$PLEX.sellVol) | |
) | |
skill_trade.vol <- melt.data.table(subset(skill_trade.mod, SolarSystemName=="Jita"), | |
id.vars=c("datetime", | |
"SolarSystemName"), | |
measure.vars=c("Injector_Sell_Volume", | |
"Injector_Buy_Volume"#, | |
#"Extractor_Sell_volume", | |
#"Extractor_Buy_Volume"#, | |
#"PLEX_Sell_Volume", | |
#"PLEX_Buy_Volume" | |
)) | |
str_split <- do.call(rbind, strsplit(as.character(skill_trade.vol$variable), "_")) #split on _ | |
skill_trade.vol <- cbind(skill_trade.vol,str_split) #combine str_split with .vol | |
colors <- c("#3399ff","#CC6677") | |
vol.max_scale <- max(skill_trade.vol$value) | |
vol.min_scale <- min(skill_trade.vol$value) | |
isk_SP.vol <- ggplot(skill_trade.vol, aes(x=datetime, | |
y=value, | |
color=V2)) | |
isk_SP.vol <- isk_SP.vol + geom_line(size=rel(1.2)) + theme_dark() | |
isk_SP.vol <- isk_SP.vol + labs(x="Date", | |
y="Order Volume", | |
color="Orders") | |
isk_SP.vol <- isk_SP.vol + scale_color_manual(values=colors) | |
isk_SP.vol <- isk_SP.vol + geom_vline(xintercept=as.numeric(x_intercepts), linetype=2, color="white") | |
if(vol.max_scale > 1e9){ | |
isk_SP.vol <- isk_SP.vol + scale_y_continuous(limits=c(min(vol.min_scale),NA),labels=function(x)sprintf("%.2fB",x/1e9)) | |
}else if(vol.max_scale > 1e6){ | |
isk_SP.vol <- isk_SP.vol + scale_y_continuous(limits=c(min(vol.min_scale),NA),labels=function(x)sprintf("%.2fM",x/1e6)) | |
}else if(vol.max_scale > 1e3){ | |
isk_SP.vol <- isk_SP.vol + scale_y_continuous(limits=c(min(vol.min_scale),NA),labels=function(x)sprintf("%.2fK",x/1e3)) | |
} | |
#isk_SP.vol <- isk_SP.vol + facet_grid(V1~.) | |
#print(isk_SP.vol) | |
filename <- paste0("ISK-SP_PARITY",title_date,".png") | |
C_plot <- plot_grid(isk_SP.price, isk_SP.vol, ncol=1, align="v") | |
png(paste0(chart_repo,filename), width=plot.width, height=plot.height) | |
print(C_plot) | |
dev.off() |
Completely irrelevant comment with respect to the information you are presenting, but vectorisation tends to be preferable to loops and dynamically growing objects in R, so for example:
add2list <- (as.Date(patch_list.full) > cutoff_date)
patch_list <- as.character(patch_list.full[add2list])
patch_title <- as.character(patch_list.names[add2list])
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Creates this