Skip to content

Instantly share code, notes, and snippets.

@wilsonfreitas
Created January 26, 2018 19:21
Show Gist options
  • Save wilsonfreitas/a875444ac3d838486add6cb05261f826 to your computer and use it in GitHub Desktop.
Save wilsonfreitas/a875444ac3d838486add6cb05261f826 to your computer and use it in GitHub Desktop.
bvbg_download_handler <- function(obj, data_ref, dest_dir) {
function () {
data <- as.Date(data_ref)
# if (obj$jump_to_current) {
# data <- today()
# }
data <- format(x=data, format="%y%m%d")
url <- 'http://www.bmfbovespa.com.br/pesquisapregao/download?filelist='
url <- paste(url, obj$url_file, data, '.zip', sep="")
dest_file <- paste(dest_dir, '/', obj$filename, '.zip', sep="")
final_file <- paste(dest_dir, '/', obj$filename, sep="")
download.file(url, dest_file, "auto")
if(file.exists(dest_file)) {
sec_zip <- unzip(zipfile=dest_file, exdir=dest_dir)
xml_files <- unzip(zipfile=sec_zip, exdir=dest_dir)
file.remove(dest_file)
file.remove(sec_zip)
file.copy(xml_files[length(xml_files)], final_file)
file.remove(xml_files)
final_file
} else {
stop(paste("Erro no download do arquivo ", obj$filename))
return(NULL)
}
}
}
bvbgopc_download_handler <- function(obj, data_ref, dest_dir) {
function() {
fname1 <- paste(dest_dir, "/", obj$filename1, sep="")
fname2 <- paste(dest_dir, "/", obj$filename1, sep="")
if(!file.exists(fname1) || !file.exists(fname2)) stop("Faça download do BVBG086 e BVBG028")
}
}
bvbg086_insert_handler <- function(con, obj, data_ref, dest_dir) {
function() {
fname <- paste(dest_dir, "/", obj$filename, sep="")
if(file.exists(fname)) {
# read file
negDoc <- xmlInternalTreeParse(fname)
negs <- getNodeSet(negDoc, "//d:PricRpt", c(d="urn:bvmf.217.01.xsd"))
#####################################################
# Insert into bdin_hist
#####################################################
stocks <- list_stocks(only_active = F)
ticker_list <- stocks$ticker
id_list <- stocks$id
negs_df <- lapply(negs, function(node) {
ticker <- xmlValue(node[['SctyId']][['TckrSymb']])
trd_dt <- xmlValue(node[['TradDt']][['Dt']])
idx <- match(ticker, ticker_list)
if(!is.na(idx) && as.character(data_ref) == as.character(trd_dt)) {
attrib <- node[['FinInstrmAttrbts']]
id_acao <- id_list[idx]
PREABE <- as.numeric(xmlValue(attrib[['FrstPric']]))
PREMIN <- as.numeric(xmlValue(attrib[['MinPric']]))
PREMED <- as.numeric(xmlValue(attrib[['TradAvrgPric']]))
PREULT <- as.numeric(xmlValue(attrib[['LastPric']]))
PREMAX <- as.numeric(xmlValue(attrib[['MaxPric']]))
OSCILA <- as.numeric(xmlValue(attrib[['OscnPctg']]))
neg1 <- as.numeric(xmlValue(attrib[['RglrTxsQty']]))
neg1 <- if(is.na(neg1)) 0 else neg1
neg2 <- as.numeric(xmlValue(attrib[['NonRglrTxsQty']]))
neg2 <- if(is.na(neg2)) 0 else neg2
TOTNEG <- neg1 + neg2
QUATOT <- as.numeric(xmlValue(attrib[['FinInstrmQty']]))
VOLTOT <- as.numeric(xmlValue(attrib[['NtlFinVol']]))
data.frame(id_acao=id_acao, data_ref=data_ref, PREABE=PREABE, PREMIN=PREMIN, PREMED=PREMED, PREULT=PREULT,
PREMAX=PREMAX, OSCILA=OSCILA, TOTNEG=TOTNEG, QUATOT=QUATOT,
VOLTOT=VOLTOT, stringsAsFactors = FALSE)
} else NA
})
negs_df <- do.call(rbind, negs_df)
if(!is.null(names(negs_df))) {
negs_df <- negs_df[!is.na(negs_df$id_acao), ]
negs_df[is.na(negs_df)] <- 0
dbWriteTable(conn = con, "bdin_hist", negs_df, transaction=TRUE, append=TRUE, row.names=FALSE)
} else {
stop("Erro ao inserir histórico de ações")
return(NULL)
}
#####################################################
# Insert into futuros_opc_hist
#####################################################
options <- list_options(src='derivative', include_futures = TRUE)
options <- options[as.Date(options$maturity_date, format = "%Y-%m-%d") >= as.Date(data_ref, format = "%Y-%m-%d"), ]
ticker_list <- options$opt_code
id_list <- options$id
negs_df <- lapply(negs, function(node) {
ticker <- xmlValue(node[['SctyId']][['TckrSymb']])
trd_dt <- xmlValue(node[['TradDt']][['Dt']])
idx <- match(ticker, ticker_list)
if(!is.na(idx) && as.character(data_ref) == as.character(trd_dt)) {
attrib <- node[['FinInstrmAttrbts']]
id_contr <- id_list[idx]
valor_ponto_contrato <- 0
volume_reais <- as.numeric(xmlValue(attrib[['NtlFinVol']]))
volume_dolar <- as.numeric(xmlValue(attrib[['IntlFinVol']]))
contratos_em_aberto <- as.numeric(xmlValue(attrib[['OpnIntrst']]))
neg1 <- as.numeric(xmlValue(attrib[['RglrTxsQty']]))
neg1 <- if(is.na(neg1)) 0 else neg1
neg2 <- as.numeric(xmlValue(attrib[['NonRglrTxsQty']]))
neg2 <- if(is.na(neg2)) 0 else neg2
n_negocios <- neg1 + neg2
contratos_negociados <- as.numeric(xmlValue(attrib[['FinInstrmQty']]))
preco_abertura <- as.numeric(xmlValue(attrib[['FrstPric']]))
preco_minimo <- as.numeric(xmlValue(attrib[['MinPric']]))
preco_maximo <- as.numeric(xmlValue(attrib[['MaxPric']]))
preco_medio <- as.numeric(xmlValue(attrib[['TradAvrgPric']]))
valor_fechamento <- as.numeric(xmlValue(attrib[['LastPric']]))
qt <- as.numeric(xmlValue(attrib[['AdjstdQt']]))
qt_tax <- as.numeric(xmlValue(attrib[['AdjstdQtTax']]))
valor_ajuste <- if (is.na(qt)) qt_tax else qt
saques <- 0
DC <- 0
DU <- 0
data.frame(id_contr=id_contr, data_ref=data_ref, valor_ponto_contrato=valor_ponto_contrato,
volume_reais=volume_reais, volume_dolar=volume_dolar, contratos_em_aberto=contratos_em_aberto,
n_negocios=n_negocios, contratos_negociados=contratos_negociados, preco_abertura=preco_abertura,
preco_minimo=preco_minimo, preco_maximo=preco_maximo, preco_medio=preco_medio,
valor_fechamento=valor_fechamento, valor_ajuste=valor_ajuste, saques=saques, DC=DC, DU=DU, stringsAsFactors = FALSE)
} else NA
})
negs_df <- do.call(rbind, negs_df)
if(!is.null(names(negs_df))) {
negs_df <- negs_df[!is.na(negs_df$id_contr), ]
negs_df[is.na(negs_df)] <- 0
negs_df$data_ref <- as.character(negs_df$data_ref)
upsert(con, "futuros_opc_hist", names(negs_df), negs_df)
#dbWriteTable(con, 'futuros_opc_hist', negs_df, transaction=TRUE, append=TRUE, row.names=FALSE)
} else {
stop("Erro ao inserir histórico de futuros e opções.")
return(NULL)
}
} else {
stop("Arquivo BVBG.086.01 não foi encontrado no diretório")
return(NULL)
}
}
}
bvbg028_insert_handler <- function(con, obj, data_ref, dest_dir) {
function() {
fname <- paste(dest_dir, "/", obj$filename, sep="")
if(file.exists(fname)) {
# read file
cadDoc <- xmlInternalTreeParse(fname)
# check ref date
doc_date <- substr(xmlValue(getNodeSet(cadDoc, "//d:CreDtAndTm", c(d="urn:bvmf.052.01.xsd"))[[1]]), 1, 10)
if (doc_date != data_ref) {
free(cadDoc)
gc()
stop("Data do arquivo de cadastro BVBG.028 não bate com a data de referência!")
}
# Filter contracts by market code (Mkt)
# 1 is spot
# 2 is futures
# 3 is options on spot
# 4 is options on futures
# 5 is forward
contr_nodes <- getNodeSet(cadDoc, "//d:FinInstrmAttrCmon[d:Mkt=2 or d:Mkt=3 or d:Mkt=4 or d:Mkt=5]/parent::*", c(d="urn:bvmf.100.02.xsd"))
curr_contracts <- list_options(src="deriv", include_futures = T)
contr_df <- lapply(contr_nodes, function(node) {
cod_merc <- xmlValue(node[['FinInstrmAttrCmon']][['Asst']])
tip_merc <- as.numeric(xmlValue(node[['FinInstrmAttrCmon']][['Mkt']]))
info <- if (tip_merc %in% c(1, 2, 5)) node[['InstrmInf']][['FutrCtrctsInf']] else node[['InstrmInf']][['OptnOnSpotAndFutrsInf']]
if (is.null(info) && tip_merc == 4) info <- node[['InstrmInf']][['DrvsOptnExrcInf']]
if(is.null(info)) { NA } else {
cod_gts <- xmlValue(info[['TckrSymb']])
if (cod_gts %in% curr_contracts$cod_gts) { NA } else {
id_underlying <- xmlValue(info[['UndrlygInstrmId']][['OthrId']][['Id']])
cod_merc <- substr(cod_gts, 1, 3)
tip_serie <- substr(cod_gts, 4, 6)
indic_tip_opc <- xmlValue(info[['OptnTp']]) # PUTT -> V CALL -> C
tip_opc <- xmlValue(info[['ExrcStyle']]) # EURO -> E AMER -> A
vencimento <- xmlValue(info[['XprtnDt']])
strike <- as.numeric(xmlValue(info[['ExrcPric']]))
if(is.null(strike) || is.na(strike)) strike <- 0
cod_isin <- xmlValue(info[['ISIN']])
indic_opc_aj <- 'N'
cod_moeda <- xmlValue(info[['TradgCcy']]) # BRL -> 2 USD -> 1
descricao <- xmlValue(node[['FinInstrmAttrCmon']][['Desc']])
# saques <- as.numeric(xmlValue(info[['WdrwlDays']]))
# DU <- as.numeric(xmlValue(info[['WrkgDays']]))
# DC <- as.numeric(xmlValue(info[['ClnrDays']]))
data.frame(id_underlying=id_underlying, cod_merc=cod_merc, tip_serie=tip_serie, data_ref=data_ref,
tip_merc=tip_merc, indic_tip_opc=indic_tip_opc, tip_opc=tip_opc, vencimento=vencimento,
strike=strike, cod_gts=cod_gts, cod_isin=cod_isin,
indic_opc_aj=indic_opc_aj, cod_moeda=cod_moeda, descricao=descricao, stringsAsFactors = FALSE)
}
}
})
contr_df <- do.call(rbind, contr_df)
if(!is.null(names(contr_df))) {
contr_df <- contr_df[!is.na(contr_df$data_ref), ]
contr_df <- contr_df[!is.na(contr_df$vencimento), ]
contr_df$indic_tip_opc[contr_df$indic_tip_opc == "CALL"] <- "C"
contr_df$indic_tip_opc[contr_df$indic_tip_opc == "PUTT"] <- "V"
contr_df$tip_opc[contr_df$tip_opc == "AMER"] <- "A"
contr_df$tip_opc[contr_df$tip_opc == "EURO"] <- "E"
contr_df$cod_moeda[contr_df$cod_moeda == "BRL"] <- 2
contr_df$cod_moeda[contr_df$cod_moeda == "USD"] <- 1
# upsert(con, "contr_cad", names(contr_df), contr_df)
dbWriteTable(con, 'contr_cad', contr_df[ , -1], transaction=TRUE, append=TRUE, row.names=FALSE)
# Insert underlying ids too
# Prepare contracts internal id list
curr_contracts <- list_options(src="deriv", include_futures = T)
contracts_id_df <- lapply(contr_nodes, function(node) {
tip_merc <- as.numeric(xmlValue(node[['FinInstrmAttrCmon']][['Mkt']]))
info <- if (tip_merc %in% c(1, 2, 5)) node[['InstrmInf']][['FutrCtrctsInf']] else node[['InstrmInf']][['OptnOnSpotAndFutrsInf']]
if (is.null(info) && tip_merc == 4) info <- node[['InstrmInf']][['DrvsOptnExrcInf']]
if (is.null(info)) {
NA
} else {
ticker <- xmlValue(info[['TckrSymb']])
int_id <- as.numeric(xmlValue(node[['FinInstrmId']][['OthrId']][['Id']]))
contr_id <- (curr_contracts[curr_contracts$opt_code == ticker, ]$id)[1]
data.frame(ticker=ticker, int_id=int_id, contr_id = contr_id, stringsAsFactors = FALSE)
}
})
contracts_id_df <- do.call(rbind, contracts_id_df)
contracts_id_df <- contracts_id_df[!is.na(contracts_id_df$ticker), ]
lapply(contr_df$cod_gts, function(cod) {
id_underlying <- (contr_df[contr_df$cod_gts == cod, ]$id_underlying)[1]
id_contr_underlying <- (contracts_id_df[contracts_id_df$int_id == id_underlying, ]$contr_id)[1]
if (!is.na(id_contr_underlying) && !is.null(id_contr_underlying)) {
orig_query <- paste0("UPDATE contr_cad SET id_underlying = {id_contr_underlying} WHERE cod_gts = '{cod}'")
orig_query <- glue(orig_query)
dbSendQuery(con, orig_query)
}
})
rm(cadDoc)
rm(contr_nodes)
}
} else {
stop("Arquivo BVBG.028.02 não foi encontrado no diretório")
return(NULL)
}
}
}
bvbg087_insert_handler <- function(con, obj, data_ref, dest_dir) {
function() {
fname <- paste(dest_dir, "/", obj$filename, sep="")
if(file.exists(fname)) {
negDoc <- xmlInternalTreeParse(fname)
negs <- getNodeSet(negDoc, "//d:IndxInf", c(d="urn:bvmf.218.01.xsd"))
#####################################################
# Insert into bdin_hist
#####################################################
stocks <- list_stocks(only_active = F)
ticker_list <- stocks$ticker
id_list <- stocks$id
idx_df <- lapply(negs, function(node) {
snode <- node[['SctyInf']]
ticker <- xmlValue(snode[['SctyId']][['TckrSymb']])
idx <- match(ticker, ticker_list)
if(!is.na(idx)) {
id_acao <- id_list[idx]
PREABE <- as.numeric(xmlValue(snode[['OpngPric']]))
PREMIN <- as.numeric(xmlValue(snode[['MinPric']]))
PREMED <- as.numeric(xmlValue(snode[['TradAvrgPric']]))
PREULT <- as.numeric(xmlValue(snode[['ClsgPric']]))
PREMAX <- as.numeric(xmlValue(snode[['MaxPric']]))
OSCILA <- as.numeric(xmlValue(snode[['OscnVal']]))*100
TOTNEG <- NA
QUATOT <- NA
VOLTOT <- NA
data.frame(id_acao=id_acao, data_ref=data_ref, PREABE=PREABE, PREMIN=PREMIN, PREMED=PREMED, PREULT=PREULT,
PREMAX=PREMAX, OSCILA=OSCILA, TOTNEG=TOTNEG, QUATOT=QUATOT,
VOLTOT=VOLTOT, stringsAsFactors = FALSE)
} else NA
})
idx_df <- do.call(rbind, idx_df)
if(!is.null(names(idx_df))) {
idx_df <- idx_df[!is.na(idx_df$id_acao), ]
idx_df[is.na(idx_df)] <- 0
dbWriteTable(conn = con, "bdin_hist", idx_df, transaction=TRUE, append=TRUE, row.names=FALSE)
} else {
stop("Erro ao inserir histórico de índices")
return(NULL)
}
} else {
stop("Arquivo BVBG.087.01 não foi encontrado no diretório")
return(NULL)
}
}
}
bvbgopc_insert_handler <- function(con, obj, data_ref, dest_dir) {
function() {
fname <- paste(dest_dir, "/", obj$filename1, sep="")
if(file.exists(fname)) {
cadDoc <- xmlInternalTreeParse(fname)
cad <- getNodeSet(cadDoc, "//d:OptnOnEqtsInf", c(d="urn:bvmf.100.02.xsd"))
stocks <- list_stocks(only_active = F)
ticker_list <- stocks$ticker
id_list <- stocks$id
# Prepare stocks internal id list
sto <- getNodeSet(cadDoc, "//d:EqtyInf", c(d="urn:bvmf.100.02.xsd"))
stocks_df <- lapply(sto, function(node) {
ticker <- xmlValue(node[['TckrSymb']])
par <- xmlParent(xmlParent(node))
int_id <- as.numeric(xmlValue(par[['FinInstrmId']][['OthrId']][['Id']]))
data.frame(ticker=ticker, int_id=int_id, stringsAsFactors = FALSE)
})
stocks_df <- do.call(rbind, stocks_df)
sto_df_ids <- stocks_df$int_id
sto_df_tcks <- stocks_df$ticker
#####################################################
# Insert into opcoes_cad
#####################################################
opts_df <- lapply(cad, function(node) {
underlying_id <- as.numeric(xmlValue(node[['UndrlygInstrmId']][['OthrId']][['Id']]))
# find underlying
idxtckr <- match(underlying_id, sto_df_ids)
underlying_ticker <- sto_df_tcks[idxtckr]
idx <- match(underlying_ticker, ticker_list)
if(!is.na(idx)) {
id_acao <- id_list[idx]
cod_opcao <- xmlValue(node[['TckrSymb']])
data_vcto <- xmlValue(node[['XprtnDt']])
tipo_opc <- xmlValue(node[['OptnTp']])
tipo_instr <- xmlValue(node[['OptnStyle']])
strike <- as.numeric(xmlValue(node[['ExrcPric']]))
instrm <- xmlParent(xmlParent(node))
internal_id <- as.numeric(xmlValue(instrm[['FinInstrmId']][['OthrId']][['Id']]))
data.frame(id_acao=id_acao, underlying = underlying_ticker, cod_opcao=cod_opcao, data_vcto=data_vcto, tipo_opc=tipo_opc, tipo_instr=tipo_instr,
strike=strike, internal_id=internal_id, data_ref=data_ref, stringsAsFactors = FALSE)
} else NA
})
opts_df <- do.call(rbind, opts_df)
if(!is.null(names(opts_df))) {
opts_df <- opts_df[!is.na(opts_df$data_ref), ]
opts_df$tipo_opc[opts_df$tipo_opc == "CALL"] <- "call"
opts_df$tipo_opc[opts_df$tipo_opc == "PUTT"] <- "put"
opts_df$tipo_instr[opts_df$tipo_instr == "AMER"] <- "american"
opts_df$tipo_instr[opts_df$tipo_instr == "EURO"] <- "european"
# get only the ones not yet in the database
curr_opts <- list_options(src='stock', strike = FALSE)
curr_opts <- curr_opts[curr_opts$maturity_date >= data_ref, ]
names(curr_opts) <- c('id_opcao', 'underlying', 'cod_opcao', 'data_vcto', 'tipo_opc', 'tipo_instr')
keys <- c('underlying', 'cod_opcao', 'data_vcto', 'tipo_opc', 'tipo_instr')
new_opts <- merge(opts_df, curr_opts, by=keys, all.x=TRUE)
new_opts <- new_opts[ which(is.na(new_opts$id_opcao)) , c('id_acao', keys) ]
dbWriteTable(con, 'opcoes_cad',
new_opts[, c("id_acao", "cod_opcao", "data_vcto", "tipo_opc", "tipo_instr")],
transaction=TRUE, append=TRUE, row.names=FALSE)
curr_opts <- list_options(src='stock', strike = FALSE)
curr_opts <- curr_opts[curr_opts$maturity_date >= data_ref, ]
names(curr_opts) <- c('id_opcao', 'underlying', 'cod_opcao', 'data_vcto', 'tipo_opc', 'tipo_instr')
authorized_opts <- merge(opts_df, curr_opts, by=keys, all.x=TRUE)
authorized_opts <- authorized_opts[!is.na(authorized_opts$id_opcao), ]
dbWriteTable(con, 'opcoes_autorizadas', authorized_opts[, c('id_opcao', 'data_ref')],
transaction=TRUE, append=TRUE, row.names=FALSE)
} else {
stop("Erro ao cadastrar opções de ações.")
return(NULL)
}
} else {
stop("Arquivo BVBG028 não encontrado")
return(NULL)
}
fname <- paste(dest_dir, "/", obj$filename2, sep="")
if(file.exists(fname)) {
# read file
negDoc <- xmlInternalTreeParse(fname)
negs <- getNodeSet(negDoc, "//d:PricRpt", c(d="urn:bvmf.217.01.xsd"))
#####################################################
# Insert into bdin_opcoes_hist
#####################################################
internal_id_list <- authorized_opts$internal_id
id_list <- authorized_opts$id_opcao
strikes <- authorized_opts$strike
negs_df <- lapply(negs, function(node) {
option_id <- as.numeric(xmlValue(node[['FinInstrmId']][['OthrId']][['Id']]))
trd_dt <- xmlValue(node[['TradDt']][['Dt']])
idx <- match(option_id, internal_id_list)
if(!is.na(idx) && as.character(data_ref) == as.character(trd_dt)) {
id_opcao <- id_list[idx]
attrib <- node[['FinInstrmAttrbts']]
PREABE <- as.numeric(xmlValue(attrib[['FrstPric']]))
PREMIN <- as.numeric(xmlValue(attrib[['MinPric']]))
PREMED <- as.numeric(xmlValue(attrib[['TradAvrgPric']]))
PREULT <- as.numeric(xmlValue(attrib[['LastPric']]))
PREMAX <- as.numeric(xmlValue(attrib[['MaxPric']]))
OSCILA <- as.numeric(xmlValue(attrib[['OscnPctg']]))
neg1 <- as.numeric(xmlValue(attrib[['RglrTxsQty']]))
neg1 <- if(is.na(neg1)) 0 else neg1
neg2 <- as.numeric(xmlValue(attrib[['NonRglrTxsQty']]))
neg2 <- if(is.na(neg2)) 0 else neg2
TOTNEG <- neg1 + neg2
QUATOT <- as.numeric(xmlValue(attrib[['FinInstrmQty']]))
VOLTOT <- as.numeric(xmlValue(attrib[['NtlFinVol']]))
data.frame(id_opcao=id_opcao, data_ref=data_ref, PREABE=PREABE, PREMIN=PREMIN, PREMED=PREMED, PREULT=PREULT,
PREMAX=PREMAX, OSCILA=OSCILA, TOTNEG=TOTNEG, QUATOT=QUATOT,
VOLTOT=VOLTOT, strike=strikes[idx], stringsAsFactors = FALSE)
} else NA
})
negs_df <- do.call(rbind, negs_df)
if(!is.null(names(negs_df))) {
negs_df <- negs_df[!is.na(negs_df$id_opcao), ]
negs_df[is.na(negs_df)] <- 0
negs_df$data_ref <- as.character(negs_df$data_ref)
upsert(con, "bdin_opcoes_hist", names(negs_df), negs_df)
# dbWriteTable(conn = con, "bdin_opcoes_hist", negs_df, transaction=TRUE, append=TRUE, row.names=FALSE)
} else {
stop("Erro ao inserir histórico de opções de ações.")
return(NULL)
}
} else {
stop("Arquivo BVBG086 não encontrado")
return(NULL)
}
}
}
upsert <- function(con, table, fields, data) {
values <- paste0('{', fields, '}')
str_values <- sapply(data[1, ], is.character)
values[str_values] <- paste0("'", values[str_values], "'")
qry_fields <- paste(fields, collapse=", ")
qry_values <- paste(values, collapse =", ", sep="")
qry_update <- paste(fields, ' = ', values, collapse = ", ", sep ="")
orig_query <- paste0("INSERT INTO {table} ({qry_fields})",
" VALUES ({qry_values})",
" ON DUPLICATE KEY UPDATE {qry_update};")
orig_query <- glue(orig_query)
ins <- lapply(1:nrow(data), function(rw) {
entry <- data[rw, ]
qry <- glue_data(.x = entry, orig_query)
dbSendQuery(con, qry)
})
dbCommit(con)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment