Created
January 26, 2018 19:21
-
-
Save wilsonfreitas/a875444ac3d838486add6cb05261f826 to your computer and use it in GitHub Desktop.
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
| 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