Skip to content
Permalink
Browse files

pq_plot

  • Loading branch information...
ShichenXie committed Mar 5, 2019
1 parent a51ad72 commit de3de6598aa38946411a7f0475f836b9685dd94e
@@ -1,4 +1,4 @@
Package: pedar
Package: pedquant
Version: 0.0.1
Title: public economic and financial data
Description:
@@ -11,7 +11,7 @@ Authors@R:
Depends:
R (>= 3.1.0)
Imports:
data.table, TTR,
data.table, TTR, zoo,
httr, curl, xml2, rvest,
jsonlite, stringi,
readxl, readr,
@@ -11,12 +11,13 @@ export(md_future_symbol)
export(md_stock)
export(md_stock_financials)
export(md_stock_symbol)
export(pd_addti)
export(pd_code)
export(pd_index)
export(pd_perf)
export(pd_plot)
export(pd_to_freq)
export(pq_addti)
export(pq_index)
export(pq_perf)
export(pq_plot)
export(pq_return)
export(pq_to_freq)
import(TTR)
import(data.table)
import(ggplot2)
@@ -48,3 +49,4 @@ importFrom(utils,data)
importFrom(utils,download.file)
importFrom(utils,menu)
importFrom(utils,read.csv)
importFrom(zoo,na.locf0)
@@ -45,32 +45,32 @@ check_fromto = function(fromto, type="date", shift = 0) {

get_from_daterange = function(date_range, from, to, min_date) {
if (is.null(from)) {
if (date_range == "max") {
from = min_date
} else if (date_range == "ytd") {
from = sub("-[0-9]{2}-[0-9]{2}", "-01-01", as.character(to))

} else if (grepl("[1-9][0-9]*d", date_range)) {
from = as.Date(to) - as.integer(sub("d","",date_range))
} else if (grepl("[1-9][0-9]*w", date_range)) {
from = as.Date(to) - as.integer(sub("d","",date_range))*7
} else if (grepl("[1-9,10,11]m", date_range)) {
month_range = as.integer(sub("m","",date_range))
month_to = as.integer(sub("^[0-9]{4}-([0-9]{1,2})-.+$", "\\1", to))
year_to = as.integer(format(as.Date(to), "%Y"))
if (month_to <= month_range) {
from = paste(year_to-1, 12+month_to-month_range, sub("[0-9]{4}-[0-9]{1,2}-","",to), sep="-")
if (date_range == "max") {
from = min_date
} else if (date_range == "ytd") {
from = sub("-[0-9]{2}-[0-9]{2}", "-01-01", as.character(to))

} else if (grepl("[1-9][0-9]*d", date_range)) {
from = as.Date(to) - as.integer(sub("d","",date_range))
} else if (grepl("[1-9][0-9]*w", date_range)) {
from = as.Date(to) - as.integer(sub("d","",date_range))*7
} else if (grepl("[1-9,10,11]m", date_range)) {
month_range = as.integer(sub("m","",date_range))
month_to = as.integer(sub("^[0-9]{4}-([0-9]{1,2})-.+$", "\\1", to))
year_to = as.integer(format(as.Date(to), "%Y"))
if (month_to <= month_range) {
from = paste(year_to-1, 12+month_to-month_range, sub("[0-9]{4}-[0-9]{1,2}-","",to), sep="-")
} else {
from = paste(year_to, month_to-month_range, sub("[0-9]{4}-[0-9]{1,2}-","",to), sep="-")
}

} else if (grepl("[1-9][0-9]*y", date_range)) {
year_range = as.integer(sub("y","",date_range))
year_from = as.integer(format(as.Date(to), "%Y")) - year_range
from = sub("^[0-9]{4}", year_from, to)
} else {
from = paste(year_to, month_to-month_range, sub("[0-9]{4}-[0-9]{1,2}-","",to), sep="-")
from = min_date
}

} else if (grepl("[1-9][0-9]*y", date_range)) {
year_range = as.integer(sub("y","",date_range))
year_from = as.integer(format(as.Date(to), "%Y")) - year_range
from = sub("^[0-9]{4}", year_from, to)
} else {
from = min_date
}
}

# set class
@@ -149,7 +149,7 @@ check_symbol_for_yahoo = function(symbol) {
if (!is.null(ex_code)) symbol = paste(syb, ex_code, sep=".")
}
}
return(symbol)
return(toupper(symbol))
}


@@ -198,6 +198,15 @@ check_mkt_src = function(market=NULL, source=NULL) {
}


# check frequency is daily data
check_freq_isdaily = function(dt) {
setkeyv(dt, "date")
# check freq of input data
diff_date = dt[, as.numeric(mean(date - shift(date, n=1, type="lag"), na.rm=TRUE)) ]

isdaily = ifelse(diff_date > 2, FALSE, TRUE)
return(isdaily)
}
########################### helper functions ###########################
# # select rows in a dataframe
# sel_row_df = function(df, col_name = NULL, stop_condi = NULL) {
@@ -241,27 +250,33 @@ load_read_csv = function(url, encode="UTF-8", handle=new_handle()) {


# fill 0/na in a vector with last non 0/na value
fill0 = function(x) {
# index of x==0
ind = which(x==0)
while (length(ind) >0 & any(!(ind %in% 1:length(ind))) ) {
# replace value with last
x[ind] <- x[ind-1]
# index of x==0
ind = which(x==0)
}
return(x)
fill0 = function(x, from_last = FALSE) {
x[x==0] <- NA
x2 = na.locf0(x, fromLast = from_last)

# xdt = data.table(x = x)
# while (xdt[x==0,.N] & xdt[,rowid:=.I][x==0, !all(rowid == .I)]) {
# xdt[, x_lag := shift(x, type='lag')
# ][x==0, x := x_lag]
# }
# x2 = xdt$x

return(x2)
}
fillna = function(x) {
# index of x==na
ind = which(is.na(x))
while (length(ind) >0 & any(!(ind %in% 1:length(ind))) ) {
# replace value with last
x[ind] <- x[ind-1]
# index of x==na
ind = which(is.na(x))
}
return(x)
#' @importFrom zoo na.locf0
fillna = function(x, from_last = FALSE) {
# https://stackoverflow.com/questions/7735647/replacing-nas-with-latest-non-na-value

x2 = na.locf0(x, fromLast = from_last)

# xdt = data.table(x = x)
# while (xdt[is.na(x),.N] & xdt[,rowid:=.I][is.na(x), !all(rowid == .I)]) {
# xdt[, x_lag := shift(x, type='lag')
# ][is.na(x), x := x_lag]
# }
# x2 = xdt$x

return(x2)
}


@@ -32,7 +32,7 @@ ed_fred1 = function(symbol1, from="1776-07-04", to="9999-12-31", na_rm=FALSE) {
query_series_tags = function(symbol1) {
setDT(fromJSON(sprintf(base_url, sprintf("series/tags?series_id=%s&", unlist(symbol1)), key))[["tags"]])[]
}
for (i in 1:5) {
for (i in 1:2) {
tags = try(query_series_tags(symbol1), silent = TRUE)
# print(i)
if (!inherits(tags, 'try-error')) {
@@ -114,7 +114,7 @@ md_forex1_fred = function(syb, from, to) {
syb_fred, from=from, to=to, print_step=0L
)[[1]][,`:=`(symbol_fred = symbol, symbol = NULL, name = NULL
)][forex_symbol_fred, on='symbol_fred', nomatch=0
][, .(symbol, name, date, value)
][, .(symbol, name, date, value, geo, unit)
][!is.na(value)]
# return
return(dt_forex_hist)
@@ -166,7 +166,12 @@ md_forex = function(symbol=NULL, date_range = '3y', from=NULL, to=Sys.Date(), pr
}

setkey(temp, 'date')
dt_list[[syb_i]] = unique(temp, by='date')
cols_fillna = intersect(c('geo', 'unit'), names(temp))
if (length(cols_fillna) > 0) {
temp = unique(temp, by='date')[, (cols_fillna) := lapply(.SD, function(x) fillna(x)), .SDcols = cols_fillna]
}

dt_list[[syb_i]] = temp
}
return(dt_list)
}
@@ -86,7 +86,9 @@ md_bond_chinabond = function(symbol, from=NULL, to=Sys.Date(), print_step=1L) {
value = as.numeric(value)
)][,.(symbol=paste0('cn',maturity,'dy_b'), name=paste('China', toupper(maturity), 'Bond Daily Yield'), date, value)]
})
dflist = rbindlist(dflist, fill = TRUE)
dflist = rbindlist(dflist, fill = TRUE)[,`:=`(
geo = 'china', unit = 'Percent'
)]

# return data list
dt_list = list()
@@ -108,7 +110,7 @@ md_bond1_fred = function(syb, from, to) {
bond_symbol_fred[symbol == syb, symbol_fred], from=from, to=to, print_step=0L
)[[1]][,`:=`(symbol_fred = symbol, symbol = NULL, name = NULL
)][bond_symbol_fred, on='symbol_fred', nomatch=0
][, .(symbol, name, date, value)
][, .(symbol, name, date, value, geo, unit)
][!is.na(value)]

setkey(dt_bond_hist, 'date')
@@ -107,7 +107,7 @@ md_libor1_hist = function(syb, from, to) {
libor_symbol[symbol == syb, symbol_fred], from=from, to=to, print_step=0L
)[[1]][,`:=`(symbol_fred = symbol, symbol = NULL, name = NULL
)][libor_symbol, on='symbol_fred', nomatch=0
][, .(symbol, name, date, value)
][, .(symbol, name, date, value, geo, unit)
][!is.na(value)]
# return
return(dt_libor_hist)
@@ -132,9 +132,13 @@ md_libor = function(symbol, from=NULL, to=Sys.Date(), print_step=1L) {
# print step info
if ((print_step>0) & (i %% print_step == 0)) cat(sprintf('%s %s\n', paste0(format(c(i, syb_len)), collapse = '/'), syb_i))
# load data
temp = rbind(md_libor1_hist(syb_i, from=from, to=to), dat_last5[symbol==syb_i])
temp = rbind(md_libor1_hist(syb_i, from=from, to=to), dat_last5[symbol==syb_i],fill=TRUE)
setkey(temp, 'date')
dt_list[[syb_i]] = unique(temp, by='date')
cols_fillna = intersect(c('geo', 'unit'), names(temp))
if (length(cols_fillna) > 0) {
temp = unique(temp, by='date')[, (cols_fillna) := lapply(.SD, function(x) fillna(x)), .SDcols = cols_fillna]
}
dt_list[[syb_i]] = temp
}
return(dt_list)
}
@@ -45,19 +45,19 @@
#' }
#'
#' @export
md_stock = function(symbol, source = "yahoo", freq = "daily", date_range = "3y", from = NULL, to = Sys.Date(), type='history', print_step = 1L, ...) {
md_stock = function(symbol, source = "yahoo", freq = "daily", date_range = "3y", from = NULL, to = Sys.Date(), type='history', adjust = TRUE, print_step = 1L, ...) {
# cat(source,"\n")
# arguments
source = check_arg(as.character(source), c('yahoo','163'), default = 'yahoo')
type = check_arg(type, c('history', 'dividends', 'splits'), default = 'history')
type = check_arg(type, c('history', 'dividend', 'split'), default = 'history')
syb = tolower(symbol)

na_rm = list(...)[['na_rm']]
if (is.null(na_rm)) na_rm = TRUE

fillzero = list(...)[['fillzero']]
if (is.null(fillzero)) fillzero = FALSE
adjust = list(...)[['adjust']]
if (is.null(adjust)) adjust = FALSE

env = list(...)[['env']]
if (is.null(env)) env = parent.frame()

@@ -66,6 +66,6 @@ md_stock = function(symbol, source = "yahoo", freq = "daily", date_range = "3y",
from = get_from_daterange(date_range, from, to, min_date = "1000-01-01")

# data
dat = try(do.call(paste0("md_stock_", source), args=list(symbol = syb, freq = freq, from = from, to = to, print_step = print_step, env = env, adjust=adjust, fillzero=fillzero, na_rm=na_rm, ...)), silent = TRUE)
dat = try(do.call(paste0("md_stock_", source), args=list(symbol = syb, freq = freq, from = from, to = to, print_step = print_step, env = env, adjust=adjust, fillzero=fillzero, na_rm=na_rm, type=type, ...)), silent = TRUE)
return(dat)
}

0 comments on commit de3de65

Please sign in to comment.
You can’t perform that action at this time.