Trouble with R function - r

I try to create a function. But when I change the sequence of it then it create NA values out. Any particular reason to it? Thanks
new<-function(x){
min2<-NULL
min1<-NULL
len<-length(unique(x))
for (i in 1:(len-1))
min2[i]<-sort(x,partial=(len-i+1))[(len-i+1)]
min1[i]<-sort(x,partial=(len-i)) [(len-i)]
return((min1))
}
x<-c(1,11,40,120)
new(x)
[1] 120 40 11
new<-function(x){
min2<-NULL
min1<-NULL
len<-length(unique(x))
for (i in 1:(len-1))
min1[i]<-sort(x,partial=(len-i)) [(len-i)]
min2[i]<-sort(x,partial=(len-i+1))[(len-i+1)]
return((min1))
}
x<-c(1,11,40,120)
new(x)
[1] NA NA 11

You forgot curly parentheses around the expression you want to repeat in you for loop:
new<-function(x){
min2<-NULL
min1<-NULL
len<-length(unique(x))
for (i in 1:(len-1)) {
min2[i]<-sort(x,partial=(len-i+1))[(len-i+1)]
min1[i]<-sort(x,partial=(len-i)) [(len-i)]
}
return(min1)
}

Related

Back testing for Stock Market with R

I am very new user for R and want to use R for back testing my Strategy. I try to combine some scripts found in web. However, it did not work according my idea. My problem is the transaction date cannot be generated according to my strategy design date.
library(quantmod)
library(lubridate)
stock1<-getSymbols("AAPL",src="yahoo",from="2016-01-01",auto.assign=F)
stock1<-na.locf(stock1)
stock1$EMA9<-EMA(Cl(stock1),n=9)
stock1$EMA19<-EMA(Cl(stock1),n=19)
stock1$EMACheck<-ifelse(stock1$EMA9>stock1$EMA19,1,0)
stock1$EMA_CrossOverUp<-ifelse(diff(stock1$EMACheck)==1,1,0)
stock1$EMA_CrossOverDown<-ifelse(diff(stock1$EMACheck)==-1,-1,0)
stock1<-stock1[index(stock1)>="2016-01-01",]
stock1_df<-data.frame(index(stock1),coredata(stock1))
colnames(stock1_df)<-c("Date","Open","High","Low","Close","Volume","Adj","EMA9","EMA19","EMACheck","EMACheck_up","EMACheck_down")
#To calculate the number of crossoverup transactions during the duration from 2016-01-01
sum(stock1_df$EMACheck_up==1 & index(stock1)>="2016-01-01",na.rm=T)
stock1_df$Date[stock1_df$EMACheck_up==1 & index(stock1)>="2016-01-01"]
sum(stock1_df$EMACheck_down==-1 & index(stock1)>="2016-01-01",na.rm=T)
stock1_df$Date[stock1_df$EMACheck_down==-1 & index(stock1)>="2016-01-01"]
#To generate the transcation according to the strategy
transaction_dates<-function(stock2,Buy,Sell)
{
Date_buy<-c()
Date_sell<-c()
hold<-F
stock2[["Hold"]]<-hold
for(i in 1:nrow(stock2)) {
if(hold == T) {
stock2[["Hold"]][i]<-T
if(stock2[[Sell]][i] == -1) {
#stock2[["Hold"]][i]<-T
hold<-F
}
} else {
if(stock2[[Buy]][i] == 1) {
hold<-T
stock2[["Hold"]][i]<-T
}
}
}
stock2[["Enter"]]<-c(0,ifelse(diff(stock2[["Hold"]])==1,1,0))
stock2[["Exit"]]<-c(ifelse(diff(stock2[["Hold"]])==-1,-1,0),0)
Buy_date <- stock2[["Date"]][stock2[["Enter"]] == 1]
Sell_date <- stock2[["Date"]][stock2[["Exit"]] == -1]
if (length(Sell_date)<length(Buy_date)){
#Sell_date[length(Sell_date)+1]<-tail(stock2[["Date"]],n=2)[1]
Buy_date<-Buy_date[1:length(Buy_date)-1]
}
return(list(DatesBuy=Buy_date,DatesSell=Sell_date))
}
#transaction dates generate:
stock1_df <- na.locf(stock1_df)
transactionDates<-transaction_dates(stock1_df,"EMACheck_up","EMACheck_down")
transactionDates
num_transaction1<-length(transactionDates[[1]])
Open_price<-function(df,x) {df[as.integer(rownames(df[df[["Date"]]==x,]))+1,][["Open"]]}
transactions_date<-function(df,x) {df[as.integer(rownames(df[df[["Date"]]==x,]))+1,][["Date"]]}
transactions_generate<-function(df,num_transaction)
{
price_buy<-sapply(1:num_transaction,function(x) {Open_price(df,transactionDates[[1]][x])})
price_sell<-sapply(1:num_transaction,function(x) {Open_price(df,transactionDates[[2]][x])})
Dates_buy<-as.Date(sapply(1:num_transaction,function(x) {transactions_date(df,transactionDates[[1]][x])}))
Dates_sell<-as.Date(sapply(1:num_transaction,function(x) {transactions_date(df,transactionDates[[2]][x])}))
transactions_df<-data.frame(DatesBuy=Dates_buy,DatesSell=Dates_sell,pricesBuy=price_buy,pricesSell=price_sell)
#transactions_df$return<-100*(transactions_df$pricesSell-transactions_df$pricesBuy)/transactions_df$pricesBuy
transactions_df$Stop_loss<-NA
return(transactions_df)
}
transaction_summary<-transactions_generate(stock1_df,num_transaction1)
transaction_summary$Return<-100*(transaction_summary$pricesSell-transaction_summary$pricesBuy)/transaction_summary$pricesBuy
transaction_summary
sum(transaction_summary$Return,na.rm=T)
Hi, I am very new user for R and want to use R for back testing my Strategy. I try to combine some scripts found in web. However, it did not work according my idea. My problem is the transaction date cannot be generated according to my strategy design date.
problem as this image
The code you have is to complicated for it's own good.
The issue lies in the fact that the functions Open_price and transactions_date look for use rownames to find a record number and then take the next one. But then instead of looking for the rownames again, it is used as an index. There it goes wrong.
If you look at the following result for the first date, it returns 40.
as.integer(rownames(stock1_df[stock1_df[["Date"]] == "2016-03-01", ]))
[1] 40
So the next record it would look for will be 41. But stock_df[41, ] is not the same as rowname 41. An issue with rownames is that if you filter / remove records from the data.frame the rownames don't change. To get the correct index number you should use which. If you look at the stock1_df, you can see that it returns 21 and we need record 22
which(stock1_df[["Date"]] == "2016-03-01")
[1] 21
I changed the Open_price and transactions_date functions to use the which function. This will now return the correct results.
Open_price <- function(df, x) {
df[which(df[["Date"]] == x) + 1, ][["Open"]]
}
transactions_date <- function(df, x) {
df[which(df[["Date"]] == x) + 1, ][["Date"]]
}
head(transaction_summary)
DatesBuy DatesSell pricesBuy pricesSell Stop_loss Return
1 2016-03-02 2016-04-25 100.51 105.00 NA 4.467215
2 2016-05-27 2016-06-20 99.44 96.00 NA -3.459374
3 2016-07-13 2016-09-12 97.41 102.65 NA 5.379322
4 2016-09-15 2016-11-02 113.86 111.40 NA -2.160547
5 2016-12-12 2017-06-13 113.29 147.16 NA 29.896728
6 2017-07-17 2017-09-19 148.82 159.51 NA 7.183166
A bit of advice, try to use spaces in your code. That makes it more readable. Look for example at this style guide. Your whole code be rewritten to only use stock1 without the need to turning it into a data.frame halfway your code. But for now the code does what it needs to do.

Back testing for Stock analysis with R

I am a newbie of "R" and I want to write a script for back testing my strategy of buy and sell according to the EMA. I write the following code according to some reference from Web. However, the script got an error message in line 72 but I cannot figure out the problem. Anybody can help to solve my problem? Thanks in advance.
library(quantmod)
stock1<-getSymbols("^DJI",src="yahoo",from="2010-01-01",auto.assign=F)
stock1<-na.locf(stock1)
stock1$EMA9<-EMA(Cl(stock1),n=9)
stock1$EMA19<-EMA(Cl(stock1),n=19)
stock1$EMACheck<-ifelse(stock1$EMA9>stock1$EMA19,1,0)
stock1$EMA_CrossOverUp<-ifelse(diff(stock1$EMACheck)==1,1,0)
stock1$EMA_CrossOverDown<-ifelse(diff(stock1$EMACheck)==-1,-1,0)
stock1<-stock1[index(stock1)>="2010-01-01",]
stock1_df<-data.frame(index(stock1),coredata(stock1))
colnames(stock1_df)<-c("Date","Open","High","Low","Close","Volume","Adj","EMA9","EMA19","EMACheck","EMACheck_up","EMACheck_down")
head(stock1_df)
#To calculate the number of crossoverup transactions during the duration from 2010-01-01
sum(stock1_df$EMACheck_up==1 & index(stock1)>="2010-01-01",na.rm=T)
stock1_df$Date[stock1_df$EMACheck_up==1 & index(stock1)>="2010-01-01"]
sum(stock1_df$EMACheck_down==-1 & index(stock1)>="2010-01-01",na.rm=T)
stock1_df$Date[stock1_df$EMACheck_down==-1 & index(stock1)>="2010-01-01"]
#To generate the transcation according to the strategy
transaction_dates<-function(stock2,Buy,Sell)
{
Date_buy<-c()
Date_sell<-c()
hold<-F
stock2[["Hold"]]<-hold
for(i in 1:nrow(stock2)) {
if(hold == T) {
stock2[["Hold"]][i]<-T
if(stock2[[Sell]][i] == -1) {
#stock2[["Hold"]][i]<-T
hold<-F
}
} else {
if(stock2[[Buy]][i] == 1) {
hold<-T
stock2[["Hold"]][i]<-T
}
}
}
stock2[["Enter"]]<-c(0,ifelse(diff(stock2[["Hold"]])==1,1,0))
stock2[["Exit"]]<-c(ifelse(diff(stock2[["Hold"]])==-1,-1,0),0)
Buy_date <- stock2[["Date"]][stock2[["Enter"]] == 1]
Sell_date <- stock2[["Date"]][stock2[["Exit"]] == -1]
if (length(Sell_date)<length(Buy_date)){
#Sell_date[length(Sell_date)+1]<-tail(stock2[["Date"]],n=2)[1]
Buy_date<-Buy_date[1:length(Buy_date)-1]
}
return(list(DatesBuy=Buy_date,DatesSell=Sell_date))
}
#transaction dates generate:
transactionDates<-transaction_dates(stock1_df,"EMACheck_up","EMACheck_down")
transactionDates
num_transaction1<-length(transactionDates[[1]])
Open_price<-function(df,x) {df[as.integer(rownames(df[df[["Date"]]==x,]))+1,][["Open"]]}
transactions_date<-function(df,x) {df[as.integer(rownames(df[df[["Date"]]==x,]))+1,][["Date"]]}
transactions_generate<-function(df,num_transaction)
{
price_buy<-sapply(1:num_transaction,function(x) {Open_price(df,transactionDates[[1]][x])})
price_sell<-sapply(1:num_transaction,function(x) {Open_price(df,transactionDates[[2]][x])})
Dates_buy<-as.Date(sapply(1:num_transaction,function(x) {transactions_date(df,transactionDates[[1]][x])}))
Dates_sell<-as.Date(sapply(1:num_transaction,function(x) {transactions_date(df,transactionDates[[2]][x])}))
transactions_df<-data.frame(DatesBuy=Dates_buy,DatesSell=Dates_sell,pricesBuy=price_buy,pricesSell=price_sell)
#transactions_df$return<-100*(transactions_df$pricesSell-transactions_df$pricesBuy)/transactions_df$pricesBuy
transactions_df$Stop_loss<-NA
return(transactions_df)
}
transaction_summary<-transactions_generate(stock1_df,num_transaction1)
transaction_summary$Return<-100*(transaction_summary$pricesSell-transaction_summary$pricesBuy)/transaction_summary$pricesBuy
transaction_summary
Your code fails on this line:
transactionDates<-transaction_dates(stock1_df,"EMACheck_up","EMACheck_down")
The reason is that the first 19 records of stock1_df contain NA values in the columns "EMACheck_up" and "EMACheck_down".
head(stock1_df)
EMACheck_up EMACheck_down
1 NA NA
2 NA NA
3 NA NA
4 NA NA
5 NA NA
6 NA NA
You can solve your issue by running na.locf before running the offending line of code.
stock1_df <- na.locf(stock1_df)
transactionDates <-
transaction_dates(stock1_df, "EMACheck_up", "EMACheck_down")
Skipping the first 19 rows (or first month) would also work.
You might want to look into quantstrat if you want to do more in backtesting strategies. But what you have now does the trick.

how to map a dataframe and vectors into function parameters with *pply functions

The problem I met is specific operation for *pply(like apply or mapply, etc, I'm not sure).
The dataframe is dlt:
dlt.1 dlt.2 dlt.3 dlt.4 dlt.5
1 3.244198 6.482869 9.711874 12.92918 16.13489
6 3.196401 6.391871 9.585553 12.77681 15.96547
19 3.182911 6.365424 9.547196 12.72799 15.90795
24 3.164079 6.328089 9.491971 12.65577 15.81984
and the vector is freq:
1 2 3 4 5
Now I intend to map the dt and freqn to a function foo:
foo <- function( dlti, freqi){ dlti * freqi }
where I hope the ith column of dlt correspond to the ith element of freq
I tried apply and mapply, but both failed. Would anyone please show me what is correct way?
It is not clear from your question what you actually want because you don't show the desired result. Without that, there is ambiguity in your question.
dlt <- tribble(
~dlt_1, ~dlt_2, ~dlt_3, ~dlt_4, ~dlt_5 ,
3.244198, 6.482869, 9.711874, 12.92918, 16.13489,
3.196401, 6.391871, 9.585553, 12.77681, 15.96547,
3.182911, 6.365424, 9.547196, 12.72799, 15.90795,
3.164079, 6.328089, 9.491971, 12.65577, 15.81984
)
freqi <- c(1,2,3,4,5)
foo <- function(dlti,freqi){dlti * freqi}
purrr::map2(dlt,freqi,foo)
$dlt_1
[1] 3.244198 3.196401 3.182911 3.164079
$dlt_2
[1] 12.96574 12.78374 12.73085 12.65618
$dlt_3
[1] 29.13562 28.75666 28.64159 28.47591
$dlt_4
[1] 51.71672 51.10724 50.91196 50.62308
$dlt_5
[1] 80.67445 79.82735 79.53975 79.09920
In base R, we can do this by replicating the 'freq' and then do the *
dlt*freq[col(dlt)]
# dlt.1 dlt.2 dlt.3 dlt.4 dlt.5
#1 3.244198 12.96574 29.13562 51.71672 80.67445
#6 3.196401 12.78374 28.75666 51.10724 79.82735
#19 3.182911 12.73085 28.64159 50.91196 79.53975
#24 3.164079 12.65618 28.47591 50.62308 79.09920
Or using Map in base R
dlt[] <- Map(`*`, dlt, freq)

How to subset 'n' number of rows past a certain value?

I'm trying to subset a data.frame based on a 1 or 0 value the data.frame.
Here is some sample code;
> Test
Close High Low Dn.BB MaVg Up.BB Per.BB Dn.Brk
2007-02-27 6286.1 6434.7 6270.5 6305.813 6389.679 6473.544 -0.11752900 1
2007-02-28 6171.5 6286.1 6166.2 6237.635 6377.186 6516.737 -0.23695539 1
2007-03-01 6116.0 6230.7 6038.9 6164.470 6358.129 6551.787 -0.12514308 1
2007-03-02 6116.2 6164.4 6085.6 6110.807 6341.179 6571.550 0.01170495 0
2007-03-05 6058.7 6116.2 5989.6 6047.421 6318.100 6588.779 0.02083561 0
2007-03-06 6138.5 6138.5 6058.7 6018.953 6297.907 6576.861 0.21427696 0
2007-03-07 6156.5 6167.6 6106.1 6001.139 6278.136 6555.133 0.28043853 0
2007-03-08 6227.7 6233.1 6156.5 5997.989 6264.436 6530.882 0.43106389 0
2007-03-09 6245.2 6255.8 6190.3 6003.152 6250.207 6497.262 0.48986661 0
2007-03-12 6233.3 6276.3 6219.3 6007.297 6237.421 6467.546 0.49104464 0
2007-03-13 6161.2 6240.7 6161.2 6000.401 6223.429 6446.457 0.36049188 0
Here, I would like to have something that iterates along the data.frame and then splits out the subsets based on Dn.Brk > 0. I can only think of a loop method here and am not to familiar with sub-setting, so was wondering if anyone could point me in the right direction / provide some tips of functions / packages that could achive this?
A little more detail below;
Sub <- rep(0,nrow(Test))
for (i in nrow(Test)){
if (Test[i,8] > 0){Sub = Test(i:i+10,1)}
}
So, the above would, at every point where Test[i,8] > 0, select, Test$Close from i:i+10.
Ideally, I'd like every sample to be stored in a separate row/column in a new df. Is that possible?
You can use sapply here:
sapply(which(Test[, 8] > 0), function(z) Test$Close[z:(z+10)])
A few things to note in the loop you provided though:
You are not iterating: Your loop is from i in nrow(Test) which is effectively nrow(Test)
You would be overwriting Sub with each iteration
If you are still in search for doing it with a for loop here is the answer:
#### results list #####
results <- list()
for (i in rows.test){
if (test[i,8] > 0)
{
results[[i]] = test$Close[i:(i+10)]
}
else {results[[i]] = "no value"}
}
This could also be further parallelisable if your dataset is huge with a package called foreach. A good intro here: http://www.vikparuchuri.com/blog/parallel-r-loops-for-windows-and-linux/. You could also change "no value" to next if you want a list with only three named elements

Building a tridiagonalsolver

Was given a task to code a tridiagonal solver.
However when i try to run the solver, i get no results.
I can't find my error in the code and would appreciate any help that i can get.
a<-cbind(-1,-1,-1)
b<-cbind(2.04,2.04,2.04,2.04)
c<-cbind(-1,-1,-1)
d<-c(40.8,0.8,0.8,200)
tridiagsolver<-function(a,b,c,d){
N<-length(b)
for (n in (2:N)){
ratio<-a[n]/b[n-1]
b[n]=b[n]-ratio*c[n-1]
d[n]=d[n]-ratio*d[n-1]
}
d[N]=d[N]/b[N]
for (n in (1:(N-1))){
d[N-n]=(d[N-n]-c[N-n]*d[N-n+1])/b[N-n]
}
return(d)
}
tridiagsolver(a,b,c,d)
> tridiagsolver(a,b,c,d)
[1] NA NA NA NA

Resources