#' @export
get_clean_symbol <- function(x) {
prefix <- substr(x, 1, 1)
x <- gsub("^[befiopz]", "", x)
x <- gsub(",\\(non_opt\\)", "", x)
idx <- which(prefix %in% c("z", "f", "p"))
if(length(idx) > 0)
x[idx] <- sapply(strsplit(x[idx], "\\."), "[[", 1)
idx <- which(prefix == "o")
if(length(idx) > 0)
x[idx] <- sapply(strsplit(x[idx], ","), "[[", 1)
x
}
#' @export
get_symbol_names <- function(x, exg = NULL) {
message("cleaning up symbol...")
prefix <- substr(x, 1, 1)
x <- gsub("^[befiopz]", "", x)
x <- gsub(",\\(non_opt\\)", "", x)
res <- rep(NA, length(x))
message("bonds...")
idx <- which(prefix == "b")
if(length(idx) > 0)
res[idx] <- get_names_b(x[idx], exg[idx])
message("currencies...")
idx <- which(prefix == "c")
if(length(idx) > 0)
res[idx] <- get_names_c(x[idx], exg[idx])
message("mutual funds...")
idx <- which(prefix == "m")
if(length(idx) > 0)
res[idx] <- get_names_m(x[idx], exg[idx])
message("equities...")
idx <- which(prefix == "e")
if(length(idx) > 0)
res[idx] <- get_names_e(x[idx], exg[idx])
message("indices...")
idx <- which(prefix == "i")
if(length(idx) > 0)
res[idx] <- get_names_i(x[idx], exg[idx])
message("spreads...")
idx <- which(prefix == "z")
if(length(idx) > 0)
res[idx] <- get_names_z(x[idx], exg[idx])
message("futures...")
idx <- which(prefix == "f")
if(length(idx) > 0)
res[idx] <- get_names_f(x[idx], exg[idx])
message("options...")
idx <- which(prefix == "o")
if(length(idx) > 0)
res[idx] <- get_names_o(x[idx], exg[idx])
message("future options...")
idx <- which(prefix == "p")
if(length(idx) > 0)
res[idx] <- get_names_p(x[idx], exg[idx])
res
}
## internal
##---------------------------------------------------------
month_code <- c("F","G","H","J","K","M","N","Q","U","V","X","Z")
month_val <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
simple_lookup <- function(x, ltab) {
ltab$name[match(x, ltab$symbol)]
}
lookup_w_exg <- function(x, exg, ltab, ltabu, name = "") {
res <- ltabu$name[match(x, ltabu$symbol)]
if(is.null(exg)) {
message(name, " symbols are uniquely defined by exchange and symbol and exchange was not specified... symbols that are not unique across all exchanges will not be matched")
} else {
idx <- which(is.na(res))
res[idx] <- ltab$name[match(paste(exg[idx], x[idx]), paste(ltab$exg, ltab$symbol))]
}
res
}
get_names_z <- function(x, exg = NULL) {
tmp <- strsplit(x, "\\.|_")
symb_base <- sapply(tmp, "[[", 1)
name_base <- symb_z$name_base[match(paste(exg, symb_base), paste(symb_z$exg, symb_z$symbol_base))]
first <- sapply(tmp, "[[", 2)
second <- sapply(tmp, "[[", 3)
to_time <- function(a, first = TRUE) {
res <- rep("", length(a))
idx <- which(nchar(a) == 3 & grepl("^[GFXVQNJKUHZM]", a))
yr <- substr(a[idx], 2, 3)
yri <- suppressWarnings(as.integer(yr))
yr[!is.na(yri)] <- paste("'", yr[!is.na(yri)], sep = "")
yr[is.na(yri)] <- ""
res[idx] <- paste(" ",
month_val[match(substr(a[idx], 1, 1), month_code)],
yr, ifelse(first, " ", ""), sep = "")
# "0_3" is "Spot vs. 3mo"
res[a == "0"] <- " Spot "
res[a == "3"] <- " 3mo"
res
}
new <- paste(name_base, to_time(first), "vs.", to_time(second, FALSE), sep = "")
gsub("^ +", "", new)
}
get_names_c <- function(x, exg = NULL) {
rep("", length(x))
}
get_names_f <- function(x, exg = NULL) {
tmp <- strsplit(x, "\\.")
symb_base <- sapply(tmp, "[[", 1)
name_base <- symb_f$name_base[match(paste(exg, symb_base), paste(symb_f$exg, symb_f$symbol_base))]
suffix <- sapply(tmp, function(a) {
if(length(a) == 1) {
return("")
} else {
return(a[2])
}
})
nc <- nchar(suffix)
res <- rep("", length(suffix))
idx <- which(nc == 3 & grepl("^[GFXVQNJKUHZM]", suffix))
if(length(idx) > 0) {
res[idx] <- paste(
month_val[match(substr(suffix[idx], 1, 1), month_code)],
"'", substr(suffix[idx], 2, 3), sep = "")
}
idx <- which(nc > 0 & nc < 3)
if(length(idx) > 0) {
res[idx] <- paste(suffix[idx], "mo", sep = "")
res[idx][res[idx] == "0mo"] <- "Spot"
}
res <- paste(name_base, res)
res <- gsub(" +$", "", res)
# symb_f$res <- res
# idx <- which(symb_f$res != symb_f$name)
res
}
get_names_p <- function(x, exg = NULL) {
tmp <- strsplit(x, "\\.")
symb_base <- sapply(tmp, "[[", 1)
name_base <- symb_p$name_base[match(paste(exg, symb_base), paste(symb_p$exg, symb_p$symbol_base))]
a <- sapply(tmp, "[[", 2)
b <- sapply(tmp, "[[", 3)
tm <- paste(
month_val[match(substr(a, 1, 1), month_code)],
"'", substr(a, 2, 3), sep = "")
res <- paste(name_base, tm, gsub("([0-9]+)", "\\1 ", b))
# symb_p$res <- res
# idx <- which(symb_p$res != symb_p$name)
res
}
get_names_e <- function(x, exg = NULL) {
lookup_w_exg(x, exg, symb_e, symb_e_unq, "equity")
}
get_names_i <- function(x, exg = NULL) {
lookup_w_exg(x, exg, symb_i, symb_i_unq, "index")
}
get_names_b <- function(x, exg = NULL) {
simple_lookup(x, symb_b)
}
get_names_m <- function(x, exg = NULL) {
simple_lookup(x, symb_m)
}
get_names_o <- function(x, exg = NULL) {
symb <- gsub("([A-Z0-9 ]+),.*", "\\1", x)
# need to get right exg for the symbol
exg <- symb_o$exg[match(symb, symb_o$symbol)]
res <- rep("", length(x))
idx <- symb_o$prefix == "e"
if(length(which(idx)) > 0)
res[idx] <- paste(get_names_e(symb[idx], exg[idx]), "(equity option)")
if(length(which(!idx)) > 0)
res[!idx] <- paste(get_names_i(symb[!idx], exg[!idx]), "(index option)")
res
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.