Skip to content
Permalink
Browse files

0.1.2

  • Loading branch information...
ShichenXie committed May 25, 2019
1 parent 8171503 commit 53456e4b2ec15561edb224dd442ec1f3ce68d664
@@ -1,5 +1,6 @@
# Generated by roxygen2: do not edit by hand

export(ed_code)
export(ed_fred)
export(ed_fred_symbol)
export(ed_nbs)
@@ -11,7 +12,6 @@ export(md_future_symbol)
export(md_stock)
export(md_stock_financials)
export(md_stock_symbol)
export(pd_code)
export(pq_addti)
export(pq_index)
export(pq_perf)
@@ -1,4 +1,8 @@
# pedquant 0.1.0.99
# pedquant 0.1.1.999

* Modified ed_nbs functions to load data in Chinese

# pedquant 0.1.1

* Added functions of pq_portfolio and pq_backtest
* Fixed multiple bugs in pq_plot.
@@ -306,6 +306,19 @@ load_read_csv = function(url, encode="UTF-8", handle=new_handle()) {
}


#' @importFrom webdriver run_phantomjs Session install_phantomjs
load_web_source = function(url) {
pjs <- try(run_phantomjs(), silent = TRUE)
if (inherits(pjs, 'try-error')) {
cat('Installing phantomjs ...\n')
install_phantomjs()
pjs <- try(run_phantomjs(), silent = TRUE)
}
ses <- Session$new(port = pjs$port)
ses$go(url)
wb = ses$getSource()
return(wb)
}

# fill 0/na in a vector with last non 0/na value
fill0 = function(x, from_last = FALSE) {
@@ -1,22 +1,22 @@

#' code list by category
#'
#' \code{pd_code} get the code list of country, currency, stock exchange and commodity exchange.
#' \code{ed_code} get the code list of country, currency, stock exchange and commodity exchange.
#'
#' @param cate The available category values including 'country', 'currency', 'stock_exchange', 'commodity_exchange'.
#'
#' @examples
#' \donttest{
#' # specify the categories
#' code_list1 = pd_code(cate = c('country', 'currency'))
#' code_list1 = ed_code(cate = c('country', 'currency'))
#'
#' # interactivly return code list
#' code_list2 = pd_code()
#' code_list2 = ed_code()
#'
#' }
#'
#' @export
pd_code = function(cate=NULL) {
ed_code = function(cate=NULL) {
code_category = c('country', 'currency', 'stock_exchange', 'commodity_exchange')

# market category
@@ -13,7 +13,7 @@ sel_nbs_url = function(eng) {
dim_nbs_db = function() {
nbs_db = setDT(list(
dim_region = rep('cn',8),
dim_geo_type = rep(c('national', 'province', 'city'), c(3,3,2)),
dim_geo_type = rep(c('nation', 'province', 'city'), c(3,3,2)),
dim_freq = c("monthly","quarterly","yearly", "monthly","quarterly","yearly", "monthly","yearly"),
dim_sta_db = c("hgyd","hgjd","hgnd","fsyd","fsjd","fsnd","csyd","csnd")
))
@@ -22,18 +22,9 @@ dim_nbs_db = function() {



#' @importFrom webdriver run_phantomjs Session install_phantomjs
#' @importFrom rvest html_nodes html_text %>%
nbs_read_json = function(url, eng=FALSE) {
pjs <- try(run_phantomjs(), silent = TRUE)
if (inherits(pjs, 'try-error')) {
cat('Installing phantomjs via webdriver::install_phantomjs ...\n')
install_phantomjs()
pjs <- try(run_phantomjs(), silent = TRUE)
}
ses <- Session$new(port = pjs$port)
ses$go(url)
wb = ses$getSource()
wb = load_web_source(url)

dt = read_html(wb) %>%
html_nodes('pre') %>%
@@ -79,7 +70,7 @@ nbs_symbol1 = function(geo_type=NULL, freq=NULL, symbol='zb', eng=FALSE) {
#'
#' \code{ed_nbs_symbol} provides an interface to query symbols of economic indicators from NBS.
#'
#' @param geo_type geography type in NBS, including 'national', 'province', 'city'. Default is NULL.
#' @param geo_type geography type in NBS, including 'nation', 'province', 'city'. Default is NULL.
#' @param freq the frequency of NBS indicators, including 'monthly', 'quarterly', 'yearly'. Default is NULL.
#' @param eng logical. The language of the query results is in English or in Chinese. Default is FALSE.
#'
@@ -96,7 +87,7 @@ ed_nbs_symbol = function(geo_type=NULL, freq=NULL, eng=FALSE) {
symbol = is_parent = NULL

# geography type
geo_type = check_arg(geo_type, choices = c("national", "province", "city"), arg_name = 'geo_type')
geo_type = check_arg(geo_type, choices = c("nation", "province", "city"), arg_name = 'geo_type')
# frequency
if (geo_type=="city") {
freq = check_arg(freq, choices = c("monthly", "yearly"), arg_name = 'freq')
@@ -147,7 +138,7 @@ ed_nbs_subregion = function(geo_type=NULL, eng=FALSE) {

# geography type
geo_type = check_arg(geo_type, c("province", "city"), default = NULL, arg_name = 'geo_type')
if (geo_type == 'national') return(NULL)
if (geo_type == 'nation') return(NULL)
# name of geography in NBS
nbs_geo = dim_nbs_db()[
dim_region=='cn' & dim_geo_type==geo_type, ][.N,dim_sta_db]
@@ -291,7 +282,7 @@ nbs_jsondat_format = function(jsondat) {
#'
#' @param symbol symbols of NBS indicators. It is available via \code{ed_nbs_symbol}. Default is NULL.
#' @param freq the frequency of NBS indicators, including 'monthly', 'quarterly', 'yearly'. Default is NULL.
#' @param geo_type geography type in NBS, including 'national', 'province', 'city'. Default is NULL.
#' @param geo_type geography type in NBS, including 'nation', 'province', 'city'. Default is NULL.
#' @param subregion codes of province or city, which is available via \code{ed_nbs_subregion}. Default is NULL.
#' @param date_range date range. Available value includes '1m'-'11m', 'ytd', 'max' and '1y'-'ny'. Default is '10y'.
#' @param from the start date. Default is NULL. If it is NULL, then calculate using date_range and end date.
@@ -305,8 +296,8 @@ nbs_jsondat_format = function(jsondat) {
#' dt = ed_nbs()
#'
#' # specify paratmeters
#' dt1 = ed_nbs(geo_type='national', freq='quarterly', symbol='A010101')
#' # or using 'n'/'q' represents 'national'/'quarterly'
#' dt1 = ed_nbs(geo_type='nation', freq='quarterly', symbol='A010101')
#' # or using 'n'/'q' represents 'nation'/'quarterly'
#' dt2 = ed_nbs(geo_type='n', freq='q', symbol='A010101')
#'
#'
@@ -326,7 +317,7 @@ ed_nbs = function(symbol=NULL, freq=NULL, geo_type=NULL, subregion=NULL, date_ra

# arguments
## geography type
geo_type = check_arg(geo_type, c("national", "province", "city"), arg_name = 'geo_type')
geo_type = check_arg(geo_type, c("nation", "province", "city"), arg_name = 'geo_type')
## frequency
if (geo_type=="city") {
freq = check_arg(freq, choices = c("monthly", "yearly"), arg_name = 'freq')
@@ -364,7 +355,7 @@ ed_nbs = function(symbol=NULL, freq=NULL, geo_type=NULL, subregion=NULL, date_ra
for (i in sybs) {
temp = dat[symbol==i]
setkeyv(temp, c('geo_code','date'))
dat_lst[[i]] = temp
dat_lst[[i]] = temp[,geo_code := NULL]
}
return(dat_lst)
}
@@ -79,14 +79,14 @@ md_stock_spotall_163 = function(symbol = c('a','index'), only_symbol = FALSE, sh
}
} else {
if (!identical(symbol, 'index')) {
cols_rm = intersect(names(df_stock_cn), c('eps', 'net_income', 'revenue' ))
cols_rm = intersect(names(df_stock_cn), c('eps', 'net_income', 'revenue'))
if (length(cols_rm)>0) df_stock_cn = df_stock_cn[, (cols_rm) := NULL]
}
}

df = df_stock_cn[,unit := 'CNY'][, symbol := check_symbol_for_yahoo(symbol, market)]#[, mkt := NULL][]

cols_rm = intersect(names(df), c('sector', 'industry', 'province', 'plate_ids', 'region')) # ,
cols_rm = intersect(names(df), c('sector', 'industry', 'province', 'plate_ids', 'region', 'prev_close')) # ,
if (length(cols_rm)>0) df = df[, (cols_rm) := NULL]
return(df)
}
@@ -147,7 +147,7 @@ md_stock_spot_tx = function(symbol1, only_syb_nam = FALSE, ...) {
# if (dt[1,time] < as.POSIXct(paste(dt[1,date], '15:00:00')))
# cat('The close is the spot price at', dt[1, as.character(time)], '\n')

return(dt[,unit := 'CNY'])
return(dt[, `:=`(unit = 'CNY')])
}


@@ -186,7 +186,7 @@ md_stock_hist1_163 = function(symbol1, from='1900-01-01', to=Sys.Date(), zero_rm
# set names of datatable
cols_name = c('date', 'symbol', 'name', 'open', 'high', 'low', 'close', 'prev_close', 'change', 'change_pct', 'volume', 'amount', 'turnover', 'cap_market', 'cap_total')
setnames(dt, cols_name)

setkeyv(dt, 'date')

# if (max(dt[['date']]) < lwd()) dt = rbindlist(list(dt, md_stock_spot1_tx(symbol1)[,names(dt), with=FALSE]), fill = FALSE)
dt = dt[, symbol := check_symbol_for_yahoo(symbol1)][, (cols_name[c(2,3,1,4:15)]), with=FALSE]
@@ -215,7 +215,7 @@ md_stock_hist1_163 = function(symbol1, from='1900-01-01', to=Sys.Date(), zero_rm
}

# create unit/name columns
dt = dt[, unit := 'CNY'][, name := name[.N]]
dt = dt[, `:=`(unit = 'CNY')]#[, name := name[.N]]
setkeyv(dt, 'date')
return(dt)
}
@@ -414,6 +414,11 @@ md_stock_163 = function(symbol, from='1900-01-01', to=Sys.Date(), print_step=1L,
}


dat_list = lapply(dat_list, function(x) {
cols_rm = intersect(names(x), c('prev_close', 'change', 'change_pct'))
if (length(cols_rm)>0) x = x[, (cols_rm) := NULL]
return(x)
})
return(dat_list)
}

@@ -1,6 +1,6 @@
# https://github.com/joshuaulrich/quantmod/blob/a8e9cb87825c0997a8468f5105db6c507b26ac5d/R/adjustOHLC.R
adjust_ohlc = function(dt, source, adjust_on = 'dividend', ...) {
close_adj=ratio=symbol=V1=.=dividends=splits=issue_rate=issue_price=prev_close=factor_adj_spl=factor_adj_div=factor_adj=volume=NULL
close_adj=ratio=symbol=V1=.=dividends=splits=issue_rate=issue_price=prev_close=factor_adj_spl=factor_adj_div=factor_adj=volume=name=NULL

cols_ohlc = c('open', 'high', 'low', 'close')
if (!all(cols_ohlc %in% names(dt))) return(dt)
@@ -45,22 +45,24 @@ adjust_ohlc = function(dt, source, adjust_on = 'dividend', ...) {

# adjusting ohlc price
adj_cols = c('factor_adj_spl', 'factor_adj')
dt = merge(dt, fac_adj_dt, by = 'date', all.x = TRUE
dt_adj = merge(dt, fac_adj_dt, by = 'date', all.x = TRUE
)[order(date)
][, (adj_cols) := lapply(.SD, function(x) shift(x, type = 'lead')), .SDcols=adj_cols
][, (adj_cols) := lapply(.SD, function(x) fillna(x, from_last = TRUE)), .SDcols=adj_cols
][is.na(factor_adj_spl), factor_adj_spl := 1
][is.na(factor_adj), factor_adj := 1
][, (cols_ohlc) := lapply(.SD, function(x) x/factor_adj), .SDcols = cols_ohlc
][, `:=`(
symbol = NULL, name = NULL,
volume = volume*factor_adj_spl,
prev_close = shift(close, type = 'lag'),
change = close - shift(close, type = 'lag'),
change_pct = close/shift(close, type = 'lag') - 1,
# prev_close = shift(close, type = 'lag'),
# change = close - shift(close, type = 'lag'),
# change_pct = close/shift(close, type = 'lag') - 1,
factor_adj = NULL,
factor_adj_spl = NULL,
factor_adj_div = NULL
)]
dt = cbind(dt[,.(symbol, name)], dt_adj)

}
return(dt)
@@ -52,6 +52,7 @@ fs_symbol1_cn = function(symbol, type) {
fs_cn = function(symbol, type=NULL, print_step=1L) {
. = name = name_en = NULL

if (type == 'summary') return(fs_cn1_summary(symbol))
# type
fs_type_163 = setDT(copy(financial_statements_163))
type = select_rows_df(dt = fs_type_163[,.(type, name, name_en)], column = 'type', input_string=type)[,type]
@@ -128,7 +129,6 @@ fs_cn1_summary = function(symbol1) {
#' \code{md_stock_financials} provides an interface to query financial statements and indicators of listed companies in SSE and SZSE.
#'
#' @param symbol symbol of stock shares.
#' @param source the data source is '163' (http://money.163.com).
#' @param type the type of financial statements.
#' @param print_step A non-negative integer. Print symbol name by each print_step iteration. Default is 1L.
#'
@@ -149,8 +149,9 @@ fs_cn1_summary = function(symbol1) {
#' }
#'
#' @export
md_stock_financials = function(symbol, type=NULL, source="163", print_step=1L) {
if (source == "163") return(fs_cn(symbol, type, print_step))
md_stock_financials = function(symbol, type=NULL, print_step=1L) {
# if (source == "163")
return(fs_cn(symbol, type, print_step))
}


@@ -1,5 +1,12 @@
# query china stock symbol list from cninfo.com.cn
# @import RSelenium rvest data.table
sym_stock_cninfo = function(return_url=FALSE) {
# 'http://www.sse.com.cn/assortment/stock/list/share/'
# 'http://www.szse.cn/market/companys/company/index.html'

}


sym_stock_cn_cninfo = function(return_url=FALSE) {
code_name = submarket = type = . = board = delist_date = exchange = name = read_html = remoteDriver = suspend_date = symbol = NULL
html_nodes = `%>%` = html_text = html_attr = NULL
@@ -150,15 +150,16 @@ pq_backtest = function(

if (show_plot) {
w2 = w[,.(date, w_price=price, w_position=position, w_type=type)]
perf = pq_perf(pq_portfolio(ssec, w))[['equity']][,.(date, performance=value)]
perf = pq_perf(pq_portfolio(dt, w, init_equity = init_equity))[['equity']][,.(date, performance=value)]

addti_lst = list(w=list(), performance=list())
show_ti = list(...)$show_ti
if (is.null(show_ti)) show_ti = FALSE
if (show_ti) addti_lst = c(addti_lst, addti)

p = pq_plot(
dt = Reduce(function(x,y) merge(x,y, all=TRUE, by='date'), list(dt, w2, perf)),
addti = addti_lst, ...)
addti = addti_lst, date_range = 'max')
print(p)
}
return(w)
@@ -129,7 +129,7 @@ pq_portfolio = function(dt, w, init_equity=NULL, date_range='max', from=NULL, to
equity3 = equity2[,.(date)][, cum_equity := rowSums(copy(equity2)[, date := NULL], na.rm = TRUE)]


if (is.null(init_equity)) init_equity = equity3[.N, cum_equity]
if (is.null(init_equity)) init_equity = equity3[cum_equity!=0][.N, cum_equity]
cash = w[, .(value = sum(price * position)), keyby = c('date')
][][, .(date, cash_value=init_equity-cumsum(value))][]

@@ -271,10 +271,7 @@ pp_step = function(
# add new row
dtN_update = copy(dt_N)[, `:=`(
date = Sys.Date(), rowid = rowid+1, prev_x = x
)][, x := sapply(x, function(x) {
x = ifelse(rm_weekend, rowid, date)
return(x)
})]
)][, x := date][rm_weekend, x := rowid]
dt = rbindlist(list(dt, dtN_update), fill = TRUE)
setkeyv(dt, c('symbol', 'date'))

Some generated files are not rendered by default. Learn more.

Some generated files are not rendered by default. Learn more.

0 comments on commit 53456e4

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