Skip to content

Instantly share code, notes, and snippets.

@lockefox
Last active February 18, 2016 13:24
Show Gist options
  • Save lockefox/e73d1d4b28cfa103157b to your computer and use it in GitHub Desktop.
Save lockefox/e73d1d4b28cfa103157b to your computer and use it in GitHub Desktop.
PROSPER Skill Trade/RMT Plotting script
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()
@lockefox
Copy link
Author

Creates this

isk-sp_parity2016-02-14

@pullet
Copy link

pullet commented Feb 18, 2016

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