Reproducible code:
op <- par(no.readonly = TRUE)
Sys.setenv(TZ = 'UTC')
# *********************************
# 1. Installing packages
# *********************************
install.packages('quantmod')
# *********************************
# 2. Loading packages
# *********************************
require(compiler)
require(quantmod)
# *********************************
# 3. Downloading and preparing data
# *********************************
env <- new.env()
Symbols <- c('SPY', 'QQQ', 'XLF', 'GLD')
getSymbols(Symbols = Symbols, env = env, from = '1950-01-01')
args <- eapply(env = env, FUN = function(x){na.omit(merge(OpCl(x)))})
do.call(what = function(x){x}, args = args)
Last command returns
Error in (function (x) :
unused arguments (GLD = c(-0.00112536574386668, 0.00651831872330866, 0.00446927374301676, -0.00289661319073087, 0.00267082127754281, 0.000883977900552502, 0.00665188470066513, -0.0055102490632577, 0.00220848056537104, -0.0131723380900108, 0.0124333925399644, -0.00484688257325394, -0.00419426048565119, 0.00479452054794516, 0.000685714285714401, 0.00161401890707857, 0.00687915615684465, -0.00479890310786113, -0.00249433106575958, -0.00704705614912482, 0.00591850671522876, 0.000225580870742315, 0.00203942895989107,
-0.00407239819004523, 0.00226398007697526, 0.00428990742831337, -0.00112561909049991, -0.00591985428051012, 0.00758620689655176, -0.00114025085518821, 0.000930665425779686, -0.00140186915887841, -0.00187134502923969, -0.00776836158192085, -0.00593965312425759, -0.000952607763753277, 0, 0.00188146754468477, 0.00495399858457191, 0.00308129888599207, 0.00236854571293232, -0.00914419695193436, 0.00308641975308643, 0.00992438563327047, 0.00070191857744506, -0.006818716200
I would need to coerce args, which is a list, in a matrix-like object.
Since you have xts objects , I guess you need something like :
do.call(merge,args)
This will create a single time series for the 4 symbols:
tail(do.call(merge,args))
OpCl.x OpCl.x.1 OpCl.x.2 OpCl.x.3
2013-07-01 9.921627e-03 -0.0040837162 -0.0005574913 0.0006201166
2013-07-02 -1.063128e-02 0.0005122951 0.0008370536 0.0005585899
2013-07-03 3.314002e-04 0.0036082474 0.0076944600 0.0049850449
2013-07-05 8.468835e-05 0.0066023362 0.0019326339 0.0033852404
2013-07-08 3.526744e-03 0.0010025063 -0.0039758706 0.0005492494
2013-07-09 -1.820589e-03 0.0024888004 0.0015072623 0.0009092011
Related
whenever i run this line of code it throws an error:Error in match.fun(FUN) : argument "FUN" is missing, with no default
## calculating Indicator columns for each ticker
df = pblapply(as.list(unique(df$tickers)))
## rowbind data
df = rbindlist(df,use.names = TRUE))
Previous code to this error
require("BatchGetSymbols");require("quantmod");require("pbapply")
require("data.table")
## tickers
tickers = c("^NSEI","^NSEMDCP50","^NSEMDCP50","NIFTYSMLCAP50.NS","^CNX100")
## download data
data = BatchGetSymbols(tickers=tickers,first.date = "2000-01-01",last.date = Sys.Date(),
thresh.bad.data = 0.50, bench.ticker = "^GSPC",
type.return = "arit",freq.data = "daily",how.to.aggregate = "last",
do.complete.data = TRUE,do.fill.missing.prices = TRUE)
## output ticker summary
data$df.control
## extract price data
df = as.data.frame(data$df.tickers)
# adjust column names for TTR handling
names(df)[9:10] <- c("Returns_price_adjusted","Returns_closing_adjusted")
I seem to have a weird combination of NSE, rmarkdown and callr, similar in flavor to Is it possible to disable `callr` for RMarkdown?.
When I set a value to a variable to use it in something similar to a filter call implemented using NSE via nested evals and list calls, it fails horribly, but only in callr.
---
title: "Test CC2 Failure Reproducibly"
author: "Robert M Flight"
output: rmarkdown::md_document
editor_options:
chunk_output_type: console
---
```{r run_enrichments}
set.seed(1234)
create_go_annotation = function(db, ontology = NULL){
all_genes = keys(db)
go_all_gene = AnnotationDbi::select(db, keys = all_genes, columns = c("GOALL", "ONTOLOGYALL"))
if (!is.null(ontology)) {
go_all_gene = go_all_gene[go_all_gene$ONTOLOGYALL == ontology, ]
ontology_type = paste0("GO.", ontology)
} else {
ontology_type = "GO.all"
}
go_2_gene = split(go_all_gene$ENTREZID, go_all_gene$GOALL)
go_2_gene = lapply(go_2_gene, unique)
go_desc = AnnotationDbi::select(GO.db::GO.db, keys = names(go_2_gene), columns = "TERM", keytype = "GOID")$TERM
names(go_desc) = names(go_2_gene)
go_annotation = categoryCompare2::annotation(annotation_features = go_2_gene,
description = go_desc,
annotation_type = ontology_type,
feature_type = "ENTREZID")
go_annotation
}
library(org.Hs.eg.db)
library(GO.db)
library(categoryCompare2)
library(methods)
go_mf = create_go_annotation(org.Hs.eg.db, "MF")
all_features = unique(unlist(go_mf#annotation_features))
sig_features = sample(all_features, 500)
enrich = hypergeometric_feature_enrichment(
new("hypergeom_features", significant = sig_features,
universe = all_features,
annotation = go_mf),
p_adjust = "BH"
)
comb_enrich = combine_enrichments(sig1 = enrich)
sig_cutoff = 0.1
filter_enrich = get_significant_annotations(comb_enrich, padjust <= sig_cutoff)
```
Run it via callr:
r(function() rmarkdown::render(here::here("categoryCompare2_failure.Rmd"), output_file = "cc2_fails_1.md"), show = TRUE)
# Quitting from lines 13-57 (categoryCompare2_failure.Rmd)
#
# Error in FUN(X[[i]], ...) : object 'sig_cutoff' not found
# Error: callr subprocess failed: object 'sig_cutoff' not found
# > .Last.error.trace
# Stack trace:
# Process 221313:
# 1. callr:::r(function() rmarkdown::render(here::he ...
# 2. callr:::get_result(output = out, options)
# 3. throw(newerr, parent = remerr[[2]])
# x callr subprocess failed: object 'sig_cutoff' not found
# Process 221619:
# 15. (function () ...
# 16. rmarkdown::render(here::here("categoryCompare2_failure.Rmd"))
# 17. knitr::knit(knit_input, knit_output, envir = envir, quiet ...
# 18. knitr:::process_file(text, output)
# 19. base:::withCallingHandlers(if (tangle) process_tangle(gro ...
# 20. knitr:::process_group(group)
# 21. knitr:::process_group.block(group)
# 22. knitr:::call_block(x)
# 23. knitr:::block_exec(params)
# 24. knitr:::eng_r(options)
# 25. knitr:::in_dir(input_dir(), evaluate(code, envir = env, n ...
# 26. knitr:::evaluate(code, envir = env, new_device = FALSE, k ...
# 27. evaluate::evaluate(...)
# 28. evaluate:::evaluate_call(expr, parsed$src[[i]], envir = e ...
# 29. evaluate:::timing_fn(handle(ev <- withCallingHandlers(wit ...
# 30. base:::handle(ev <- withCallingHandlers(withVisible(eval( ...
# 31. base:::withCallingHandlers(withVisible(eval(expr, envir, ...
# 32. base:::withVisible(eval(expr, envir, enclos))
# 33. base:::eval(expr, envir, enclos)
# 34. base:::eval(expr, envir, enclos)
# 35. categoryCompare2:::get_significant_annotations(comb_enric ...
# 36. categoryCompare2:::get_significant_annotations(comb_enric ...
# 37. categoryCompare2:::.get_significant_combined_enrichment(i ...
# 38. base:::lapply(in_results#enriched, function(x) { ...
# 39. categoryCompare2:::FUN(X[[i]], ...)
# 40. categoryCompare2:::get_significant_annotations(x#statisti ...
# 41. categoryCompare2:::get_significant_annotations(x#statisti ...
# 42. categoryCompare2:::.get_significant_stat_results(in_resul ...
# 43. categoryCompare2:::multi_query_list(in_results#statistic_ ...
# 44. base:::lapply(queries, eval, list_to_query)
# 45. base:::FUN(X[[i]], ...)
# 46. base:::FUN(X[[i]], ...)
# 47. base:::.handleSimpleError(function (e) ...
# 48. h(simpleError(msg, call))
# x object 'sig_cutoff' not found
You can see that it complains that sig_cutoff is not found, but it exists in the environment, but does not seem to get passed down.
If I instead run it directly, it works:
rmarkdown::render(here::here("categoryCompare2_failure.Rmd"), output_file = "cc2_works.md")
I've put all the code in a github repo.
Interestingly, it's definitely a callr issue, because targets has the same issue.
callr v 1.0.7, rmarkdown v 2.11, R 4.1.0
Other package versions are in the renv.lock file.
I load fPortfolio with a pre-installed data frame attached:
library(fPortfolio)
library(PerformanceAnalytics)
data("edhec")
rets <- edhec
# compute the tangency portfolio
tp <- tangencyPortfolio(as.timeSeries(edhec))
frontier <- portfolioFrontier(as.timeSeries(edhec))
#plot(frontier) # Plots frontier, don't need this
# The problem is when I run this code:
weightsSlider(object = frontier, control = list())
When I run the last line, weightsSlider I get an Error:
Error in tclVar(starts[i]) : could not find function "tclVar"
A separate window opens up that says 'window slider'.
If I run:
capabilities()["tclVar"]
I get the error:
<NA>
NA
And when I run:
tcltk::tclVar
I get the error:
function (init = "")
{
n <- .TkRoot$env$TclVarCount <- .TkRoot$env$TclVarCount +
1L
name <- paste0("::RTcl", n)
l <- list(env = new.env())
assign(name, NULL, envir = l$env)
reg.finalizer(l$env, function(env) tcl("unset", names(env)))
class(l) <- "tclVar"
tclvalue(l) <- init
l
}
<bytecode: 0x000001b271b9ddd0>
<environment: namespace:tcltk>
I installed both the tcl and the tcltk2 packages.
fPortfolio rdocumentation
fPortfolio github
I'm trying to setup a LSTM RNN by using mxnet in R, however, while trying to train my network I get this error and R is showing me a fatal error all the time:
"[00:36:08] d:\program files (x86)\jenkins\workspace\mxnet\mxnet\src\operator\tensor./matrix_op-inl.h:155: Using target_shape will be deprecated.
[00:36:08] d:\program files (x86)\jenkins\workspace\mxnet\mxnet\src\operator\tensor./matrix_op-inl.h:155: Using target_shape will be deprecated.
[00:36:08] d:\program files (x86)\jenkins\workspace\mxnet\mxnet\src\operator\tensor./matrix_op-inl.h:155: Using target_shape will be deprecated."
here is my code:
# install.packages("drat", repos="https://cran.rstudio.com")
# drat:::addRepo("dmlc")
# install.packages("mxnet")
rm(list = ls())
require(mxnet)
require(mlbench)
inputData <- read.table(file.path(getwd(), "Data", "input.csv"),
header = TRUE, sep = ",")
inputData$X <- as.Date(inputData$X)
inputData <- na.omit(inputData)
index <- 1:nrow(inputData)*0.8
train.dates <- inputData[index,1]
test.dates <- inputData[-index,1]
inputData[,1] <- NULL
train <- inputData[index,]
test <- inputData[-index,]
train.x <- data.matrix(train[,-ncol(train)])
test.x <- data.matrix(test[,-ncol(test)])
train.y <- train[,ncol(train)]
test.y <- test[,ncol(test)]
get.label <- function(X) {
label <- array(0, dim=dim(X))
d <- dim(X)[1]
w <- dim(X)[2]
for (i in 0:(w-1)) {
for (j in 1:d) {
label[i*d+j] <- X[(i*d+j)%%(w*d)+1]
}
}
return (label)
}
X.train.label <- get.label(t(train.x))
X.val.label <- get.label(t(test.x))
X.train <- list(data=t(train.x), label=X.train.label)
X.val <- list(data=t(test.x), label=X.val.label)
batch.size = 1
seq.len = 32
num.hidden = 16
num.embed = 16
num.lstm.layer = 1
num.round = 1
learning.rate= 0.1
wd=0.00001
clip_gradient=1
update.period = 1
model <- mx.lstm(X.train, X.val,
ctx=mx.cpu(),
num.round=num.round,
update.period=update.period,
num.lstm.layer=num.lstm.layer,
seq.len=seq.len,
num.hidden=num.hidden,
num.embed=num.embed,
num.label=15,
batch.size=batch.size,
input.size=15,
initializer=mx.init.uniform(0.1),
learning.rate=learning.rate,
wd=wd,
clip_gradient=clip_gradient)
Input dataset consists of Date column, 15 features, and the target value.
Please hep me. Thanks in advance!
The message that you receive is a warning, and you can ignore it. The real problem is the mismatch of shapes. If I run your code I receive:
[14:06:36] src/ndarray/ndarray.cc:348: Check failed: from.shape() == to->shape() operands shape mismatchfrom.shape = (1,15) to.shape=(1,32)
To fix this problem set seq.len = 15, since you have 15 features. If you update the seq.len and run your code, you will see that training started (notice, I also receive the same warning as you):
[14:08:17] src/operator/tensor/./matrix_op-inl.h:159: Using target_shape will be deprecated.
[14:08:17] src/operator/tensor/./matrix_op-inl.h:159: Using target_shape will be deprecated.
[14:08:17] src/operator/tensor/./matrix_op-inl.h:159: Using target_shape will be deprecated.
Iter [1] Train: Time: 0.263811111450195 sec, NLL=2.71622828266634, Perp=15.1231742012938
Iter [1] Val: NLL=2.51107457406329, Perp=12.3181597260587
I believe this is a formatting issue with my indicator. Can someone tell me what im doing wrong here?
#....omitted the portfolio initialization above
#returns change from past day, or NA if one of the values is invalid
changeDaily<-function(x,y){if(is.na(x+y)==T){return(NA)};ifelse(x-y>0,"UP","DOWN")}
#creates column called lagPredict which uses the function changeDaily
add.indicator(strat, name = "changeDaily",arguments = list(HLC = quote(mktdata),Cl(mktdata),Lag(Cl(mktdata))), label='lagPredict')
error:
Error in has.Cl(x) : object 'mktdata' not found
Traceback:
traceback()
3: has.Cl(x)
2: Cl(mktdata)
1: add.indicator(strat, name = "changeDaily", arguments = list(HLC = quote(mktdata),
Cl(mktdata), Lag(Cl(mktdata))), label = "lagPredict")
Complete code:
source("forex.functions.R")
startDate <- '2010-01-01' # start of data
endDate <- '2015-05-01' # end of data
symbols<-c("USD/EUR")
portfolio<-acct<-strat<-"simpleLookAhead"
initSetup(symbols,portfolio,acct,strat)
dump<-lapply(symbols,function(x)forex.weeklyOHLC(x))
symbols<-gsub("/","",symbols)
#############################################################
#returns change from past day, or NA if one of the values is invalid
changeDaily<-function(x,y){if(is.na(x+y)==T){return(NA)};ifelse(x-y>0,"UP","DOWN")}
#creates column called lagPredict which uses the function changeDaily to return UP or DOWN in reference to yesterdays price
add.indicator(strat, name = "changeDaily",arguments = list(HLC = quote(mktdata),Cl(mktdata),Lag(Cl(mktdata))), label='lagPredict')
forex.functions.R
library(PerformanceAnalytics)
library(quantmod)
library(lattice)
library(IKTrading)
library(quantstrat)
Sys.setenv(TZ="EST") # set time zone
if (!exists('.blotter')) .blotter <- new.env()
if (!exists('.strategy')) .strategy <- new.env()
forex.weeklyOHLC<-function(ss){
ss<-getSymbols(ss,src="oanda",from=startDate,to=endDate)
x<-get(ss)
#x<-adjustOHLC(x,symbol.name=symbol) #calls get Splits which calls getSymbols which fails bc src != oanda
x<-to.weekly(x,indexAt='lastof',drop.time=TRUE)
indexFormat(x)<-'%Y-%m-%d'
colnames(x)<-gsub("x",ss,colnames(x))
assign(ss,x)
}
initSetup<-function(symbols,portfolio, acct, strat){
initDate <- '2009-12-31'
initEq <- 1e6
currency("USD")
stock(symbols, currency="USD", multiplier=1)
rm.strat(strat) # remove portfolio, account, orderbook if re-run
initPortf(name=portfolio, symbols, initDate=Sys.Date())
initAcct(name=acct, portfolios=portfolio,initDate=Sys.Date(), initEq=initEq)
initOrders(portfolio=portfolio, initDate=Sys.Date())
strategy(strat, store=TRUE)
}
You need to quote all the objects in the arguments list in the call to add.indicator to prevent them from being evaluated. You also need to specify the correct arguments to pass to your changeDaily function. You pass HLC, but changeDaily does not have a HLC argument.
Your add.indicator call should look something like this:
add.indicator(strat, name = "changeDaily",
arguments = list(x = quote(Cl(mktdata)), y = quote(Lag(Cl(mktdata)))),
label = 'lagPredict')