I'm backtesting trading strategies with R. This is at the moment my code.
- MergedSet$FXCloseRate contains the closing price for a certain currency pair
- MergedSet$RiskMA is the moving average of a certain risk index
- the rest should be clear
This formula at the Moment is not really fast over 11'000 entries. Why? Are data frames too slow? Where can I optimise here?
############
# STRATEGY #
############
#Null out trades and position
MergedSet$Trade <- 0
MergedSet$Position<-0
MergedSet$DailyReturn<-0
MergedSet$CumulativeReturn<-0
MergedSet$Investment<-0
MergedSet$CumulativeReturn[1:MAPeriod] <- 1
MergedSet$Investment[1:MAPeriod] <- InitialInvestment
#Strategy
n<-nrow(MergedSet)
for(i in seq(MAPeriod+1,n)){
#Updating the position
if(MergedSet$RiskMA[i] <= ParamDwn && MergedSet$RiskMA[i-1] > ParamDwn){
#sell signal, so short if no or long position active otherwise do nothing
if(MergedSet$Position[i-1] == 0 || MergedSet$Position[i-1] == 1){
MergedSet$Position[i] = -1
MergedSet$Trade[i] = 1
}
} else if(MergedSet$RiskMA[i] >= ParamUp && MergedSet$RiskMA[i-1] < ParamUp){
#buy signal, go long if no or short position active, otherwise do nothing
if(MergedSet$Position[i-1] == 0 || MergedSet$Position[i-1] == -1){
MergedSet$Position[i] = 1
MergedSet$Trade[i] = 1
}
} else {
MergedSet$Position[i] = MergedSet$Position[i-1]
}
#Return calculation
if(MergedSet$Position[i] == 1){
#long
MergedSet$DailyReturn[i] = MergedSet$FXCloseRate[i]/MergedSet$FXCloseRate[i-1]-1
} else if(MergedSet$Position[i] == -1){
#short
MergedSet$DailyReturn[i] = MergedSet$FXCloseRate[i-1]/MergedSet$FXCloseRate[i]-1
}
}
Related
I would like to update my amortisation schedule (in R code) so that it correctly amortises loans where there is a grace period (months where only interest is paid but not principal). The code correctly amortises where there isn't a grace period but fails where there is. The issue is that the loan payment function doesn't factor in that a grace period shortens the amount of periods available to pay off a loan.
The payment function (typical of what you find online) looks like this
PMT <- function(rate, nper,pv, fv=0, type=0){
pmt = ifelse(rate!=0,
(rate*(fv+pv*(1+ rate)^nper))/((1+rate*type)*(1-(1+ rate)^nper)),
(-1*(fv+pv)/nper )
)
return(pmt)
}
Ideally I would like to reword to say where there is a grace period nper (which is the number of periods) should be shorter.
I have tried this
PMT <- function(rate, nper, pv, fv=0, type=0, grace_period, instalment_amount){
if (grace_period == 0){
pmt = ifelse(rate!=0,
(rate*(fv+pv*(1+ rate)^nper))/((1+rate*type)*(1-(1+ rate)^nper)),
(-1*(fv+pv)/nper )
)
} else {
pmt = ifelse(rate!=0,
(rate*(fv+pv*(1+ rate)^(nper-grace_period)))/((1+rate*type)*(1-(1+ rate)^(nper-grace_period))) + (instalment_amount*grace_period),
(-1*(fv+pv)/nper )
)
}
return(pmt)
}
I also do this for my interest and principal instalment functions. I then run the code below (and all 3 functions which are not shown) but it doesn't work as I get the error message
"Error in PPMT(rate, 1:nper, nper, amount, grace_period) :
argument "grace_period" is missing, with no default"
This is the code after I run the 3 functions referenced above
amortization <- function(amount, annualinterestrate, paymentsperyear, years, grace_period) {
nper = paymentsperyear * years
rate = annualinterestrate / paymentsperyear
grace_period= grace_period
amortization <- data.frame(
Principal = PPMT(rate, 1:nper, nper, amount,grace_period)*-1,
Interest = IPMT(rate, 1:nper, nper, amount,grace_period)*-1
) %>% mutate(Instalment = Principal + Interest,
Balance = round(amount - cumsum(Principal),2))
if (grace_period == 0) {
return(amortization)
}
for (i in 1:nper) {
if (i <= grace_period) {
amortization$Principal[i] <- 0
amortization$Interest[i] <- rate*amount
amortization$Instalment[i] <- rate*amount
amortization$Balance[i] <- amount
} else {
amortization$Balance[i] <- amortization$Balance[i-1]- amortization$Principal[i]
#last_payment = nrow(amortization)
#amortization[last_payment, 'Principal'] = amortization[last_payment, 'Balance']
#amortization[last_payment, 'Instalment'] = amortization[last_payment, 'Balance']
#amortization[last_payment, 'Interest'] = 0
#amortization[last_payment, 'Balance'] = 0
}
}
return(amortization)
}
for (i in 1:nper) {
if (i <= grace) {
amortization$Principal[i] <- 0
amortization$Interest[i] <- rate*amount
amortization$Instalment[i] <- rate*amount
amortization$Balance[i] <- amount
} else {
amortization$Balance[i] <- amortization$Balance[i-1]- amortization$Principal[i]
}
}
return(amortization)
}
test <- amortization(1000,.06,12,10,10)
I expect the given code to output the answer : 1. However the loop runs forever. I am trying to see if while loop works for such a case. The use of while loop is necessary for the solution.
a = list(1,2,3,4)
for(i in a){
while(i != 2){
print(i)
}
}
Here are two solutions that work with while. The first one with a 'flag' set as TRUE, and the index as 1, based on the condition, set the 'flag' to FALSE
flag <- TRUE
i <- 1
while(flag) {
print(a[[i]])
i <- i + 1
if(a[[i]] == 2) {
flag <- FALSE
}
}
#[1] 1
Or we add a break
i <- 1
while(TRUE) {
print(a[[i]])
i <- i + 1
if(a[[i]] == 2) {
break
}
}
#[1] 1
The value of i does not change inside the while loop, so you never advance to the next item in list. You need if instead of while:
a = list(1,2,3,4)
for(i in a){
if(i != 2){
print(i)
}
}
for (i in 2:100 )
{
count <- 0
for (j in i )
if( (i %% j ) == 0 )
count <- count + 1
if(count == 2 )
print(i)
}
I am trying to print print prime numbers in R. Could any one help me to resolve
Let us look at your code and show what went wrong. It's the inner loop that did not loop at all:
for (i in 2:100 )
{
count <- 0
for (j in 1:i ) # you forgot to provide a vector here
if( i %% j == 0 )
count <- count + 1
if(count == 2)
print(i)
}
The answer above tries to optimise the code some more and is a more efficient solution. For example does it only test odd numbers because even ones clearly aren't prime numbers.
The below code creates the function prime_numbers which returns prime numbers up to an inputted number.
prime_numbers <- function(n) {
if (n >= 2) {
x = seq(2, n)
prime_nums = c()
for (i in seq(2, n)) {
if (any(x == i)) {
prime_nums = c(prime_nums, i)
x = c(x[(x %% i) != 0], i)
}
}
return(prime_nums)
}
else {
stop("Input number should be at least 2.")
}
}
## return the answer to your question
prime_numbers(100)
If you wanted the range 3:100, after running the above code you could run something like this:
a<-prime_numbers(100)
a[a>3]
I hope this helps!
I have an R script that I wrote which simulates how long particles need to equilibrate in a room. The room is represented with a 3 dimensional array of size max_size. Currently the script works as it is intended, but the real run time of the script is so slow that it is nearly unusable. I have tried adjusting my algorithm to reduce the number of times that the array needs to be looped over, but it is still many magnitudes slower than when I wrote this code in FORTRAN previously. How can I adjust this script in order to reduce the runtime?
Below is my code.
#!/usr/bin/env Rscript
options(warn=1)
max_size <- 10
use_partition = 1
cube <- array(dim=c(max_size, max_size, max_size))
cube[,,]=0.0
diffusion_coefficient <- 0.175
room_dimension <- 5
mol_speed <- 250 # speed of molecules based on 100 g/mol at RT
timestep <- (room_dimension/mol_speed)/max_size # h in seconds
dist_between <- room_dimension/max_size
DTerm <- diffusion_coefficient*timestep/(dist_between*dist_between)
cube[1,1,1] <- 1.0e21 # initial mass of particles
time <- 0 # keep up with accumulated system time
ratio <- 0
part_height <- floor(max_size*0.75)
center <- floor(max_size/2)
# the partition is defined as:
# 1 space (index) "wide" on the X axis
# spans 75% (rounded) of the "height" (Y axis)
# spans 100% of the "depth" (z axis)
# partition spaces are indicated with the value -69.0
# partition spaces cannot be diffused from nor into
if(use_partition == 1) {
for (j in 1:part_height) {
cube[center,j,] <- -69.0 # flag partition spaces with -69.0
}
}
repeat { #R replacement for Do While
for (i in 1:nrow(cube)) {
for (j in 1:ncol(cube)) {
for (k in 1:max_size) {
if(cube[i,j,k] != -69.0) {
for (off in seq(from=-1, to=1, by=2)) {
if (i+off >= 1 && i+off <= max_size) {
change <- (cube[i,j,k] - cube[i+off,j,k])*DTerm
cube[i,j,k] = cube[i,j,k] - change
cube[i+off,j,k] = cube[i+off,j,k] + change
}
if (j+off >= 1 && j+off <= max_size) {
change <- (cube[i,j,k] - cube[i,j+off,k])*DTerm
cube[i,j,k] = cube[i,j,k] - change
cube[i,j+off,k] = cube[i,j+off,k] + change
}
if (k+off >= 1 && k+off <= max_size) {
change <- (cube[i,j,k] - cube[i,j,k+off])*DTerm
cube[i,j,k] = cube[i,j,k] - change
cube[i,j,k+off] = cube[i,j,k+off] + change
}
}
}
}
}
}
time = time+timestep
#check mass for consistency
sumval <- 0.0
maxval <- cube[1,1,1]
minval <- cube[1,1,1]
for(i in 1:nrow(cube)) {
for(j in 1:ncol(cube)) {
for(k in 1:max_size) {
if(cube[i,j,k] != -69.0) {
if(cube[i,j,k] > maxval) {
maxval = cube[i,j,k]
}
if(cube[i,j,k] < minval) {
minval = cube[i,j,k]
}
sumval = sumval + cube[i,j,k]
}
}
}
}
ratio <- minval / maxval
cat(time, " ", ratio, " ", sumval, "\n")
if(ratio >= 0.99) {
break
}
}
cat("Box equilibrated in ", time, " seconds of simulated time.\n")
I have read in a csv file about weather on days. One of the variables is called winddirection (windrichting) but it is given in degrees and 0 and 990 have special meaning.
I want to change the numbers to North/South/West/East but when I used the replace function it changed the datatype of the whole vector to char which prevented my next replace with a range to work. So now I ended up with an if/else if/else statement but I can't get it to work. Also I get an error condition has length > 1. Can anyone help me get this to work so I have the ranges 45-135 to east, 135-225 south, etc.
here is my code where mydata$DD is the variable for wind direction with over 2000 values.
windrichting <- mydata$DD
windrichting <- if (windrichting == 990 ){
windrichting == "Veranderlijk"
} else if (windrichting>45 && windrichting<=135){
windrichting == "Oost"
} else if (windrichting>135 && windrichting<=225){
windrichting == "Zuid"
} else if (windrichting>225 && windrichting <=315){
windrichting == "West"
} else if (windrichting ==0){
windrichting == "Windstil"
} else windrichting == "Noord"
Perhaps something along the lines of this?
tmp <- round((windrichting + 45) / 90) %% 8
tmp[windrichting == 990] <- 8
tmp <- factor(tmp, levels = 0:9, labels = c("Noord", "Oost", "Zuid", "West", "Veranderlijk", "Windstil"))
tmp[windrichting == 0] <- "Windstil"
windrichting <- tmp
You can do this using an *apply function.
windrichting_text <- unlist(lapply(windrichting, function (x) {
if (x == 990) {
return("Veranderlijk")
} else if {
....
} else {
return ("Noord")
})
This applies the function defined to all elements in the list.