Is there any way to undertake rounding with custom rules? - r

I'm wondering if there's any way to round up or down based on my own rules, not just the basic 0.5 up or down.
The numbers I'm trying to round are in the form of 24 hour time i.e. 2250, 1100, 830 (but in numeric format), and I want to round up or down based on if the last two numbers are above or below 30 - and this is rounding up to the next hour.
Any help would be appreciated, thank you.

You could just offset the numbers before rounding them :
round(c(2250, 1100, 830) + 20, -2)
# [1] 2300 1100 800
You might want to add %% 2400 to it :
round(2350 + 20, -2)
# [1] 2400
round(2350 + 20, -2) %% 2400
# [1] 0
So that would be :
round_hour <- function(x) round(x + 20, -2) %% 2400
Thanks #snoram for the tip

Something along the line of this?
# Function
hround <- function(x) {
if (any(x < 0 | x > 24000)) stop("Invalid format")
mins <- x %% 100
x <- x - mins + ifelse(mins >= 30, 100, 0)
ifelse(x == 2400, 0, x)
}
# test data:
test <- c(2250, 1100, 830, 725)
# Test run
hround(test)
# [1] 2300 1100 900 700

Related

Read two numbers. Find their product after exchanging last digits

Read two numbers. Find their product after exchanging last digits.
For example: Input: 4270 and 153, output: 640950 (4273x150).
Input: 348 and 31, output: 12958 (341*38).
x <- 348
y <- 31
as.integer(paste0(x %/% 10, y %% 10)) * as.integer(paste0(y %/% 10, x %% 10))
# [1] 12958
also works vecorized
x <- c(348, 4270)
y <- c(31, 153)
as.integer(paste0(x %/% 10, y %% 10)) * as.integer(paste0(y %/% 10, x %% 10))
# [1] 12958 640950

Remove the last 0 in a list of vectors if it appears twice at the end

I have data as follows:
dat <- list(`A` = c(0, 25, 500, 1000, 0, 0), `B` = c(0,
25, 500, 1000, 1500, 0)
I would like to remove the last 0 if there are two 0's.
I am breaking my brain on how to achieve this but I cannot come up with anything.
How should I do this?
Desired output:
out_dat <- list(`A` = c(0, 25, 500, 1000, 0), `B` = c(0,
25, 500, 1000, 1500, 0)
One solution:
trim0 <- function (x) {
if (all(tail(x, 2) == 0)) x[-length(x)] else x
}
out_dat <- lapply(dat, trim0)
You can use the following code:
lapply(dat, function(x) x[c(TRUE, !x[-length(x)] == x[-1])])
Output:
$A
[1] 0 25 500 1000 0
$B
[1] 0 25 500 1000 1500 0
Try this
lapply(dat , \(x) if(rev(x)[1] == rev(x)[2] & rev(x)[1] == 0) x[1:(length(x) - 1)] else x)
output
$A
[1] 0 25 500 1000 0
$B
[1] 0 25 500 1000 1500 0

Backtesting open position counter for trading in R

Getting started on backtesting some trading data, in particular a very basic mean reversion idea and can't get my head around how to approach this concept.
How would I go about having a running 'posy' increase by 1 once DifFromFv (the deviation from fair value) reaches -10 and subsequently 'posy' increases by 1 as DifFromFv extends by multiples of -3 (-13,-16,-19, etc.) whilst having 'posy' decrease by 1 every time DifFromFv reverts back +5 from last changed 'posy'? Simply put, I am buying once the DifFromFv reaches 10 points and averaging every 3 points, whilst taking each individual average out for 5 points profit.
E.g:
DifFromFv posy
0.00 0
-10.00 1 #initial clip (target profit -5.00)
-11.50 1
-13.00 2 #avg #1 (target profit -8.00)
-16.60 3 #avg #2 (target profit -11.00)
-12.30 3
-11.00 2 #taking profit on avg #2
-14.10 2
-8.00 1 #taking profit on avg #1
-7.00 1
-5.00 0 #taking profit on initial clip
It should be noted that the take profit for every clip is consistently set at -5,-8,-11,etc. increments regardless of where the averages are filled as seen by the target profit for avg #2 being at -11.00 rather than -11.60. This is both to reduce margin of error in real-life fills vs data fills and also I'm pretty sure should make the approach to this concept a lot easier to think about.
Thanks in advance!
Next time please provide some code, even though your explanation is quite clear.
However, you didn't mention how you want to deal with large jumps in DifFromFv (for instance, if it goes from -3 to -18), so I leave it up to you.
Here is the code with comments:
library(plyr)
firstPosy = FALSE
DiffFair <- c(0, -10, -11.5, -13, -16.6, -12.3, -11, -14.1, -8, -7, -5) # Your data here
posy <- c(0)
buyPrices <- c(0) # Stores the prices at which you by your asset
targetProfit <- c(0) # Stores the target profit alongside with the vector above
steps <- c(0) # Stores your multiples of -3 after -10 (-10, -13, -16...)
PNL = 0
for (i in 2:length(DiffFair)) {
# Case where posy increments for the first time by one
if (DiffFair[i] <= -10 & DiffFair[i] > -13 & firstPosy == FALSE) {
firstPosy = TRUE
posy <- c(posy, 1)
steps <- c(steps, round_any(DiffFair[i], 10, f = ceiling))
lastChangePosy = DiffFair[i]
buyPrices <- c(buyPrices, DiffFair[i])
targetProfit <- c(targetProfit, -5)
}
else if (DiffFair[i] <= -13 & firstPosy == FALSE) {
firstPosy = TRUE
lastChangePosy = DiffFair[i]
steps <- c(steps, round_any(DiffFair[i] + 10, 3, f = ceiling) - 10)
buyPrices <- c(buyPrices, DiffFair[i])
targetProfit <- c(targetProfit, -5)
posy <- c(posy, tail(posy, n=1) + (-round_any(DiffFair[i] + 10, 3, f = ceiling) / 3) + 1)
}
# Posy increase
else if (tail(steps, n=1) > round_any(DiffFair[i] + 10, 3, f = ceiling) - 10 & DiffFair[i] <= -10) {
posy <- c(posy, posy[i-1] + 1)
steps <- c(steps, round_any(DiffFair[i] + 10, 3, f = ceiling) -10)
lastChangePosy = DiffFair[i]
buyPrices <- c(buyPrices, DiffFair[i])
targetProfit <- c(targetProfit, tail(targetProfit, n=1) - 3)
}
# Posy decrease
else if (DiffFair[i] >= tail(targetProfit, n=1) & tail(posy, n=1) > 0) {
if (tail(targetProfit, n=1) == -5) {
posy <- c(posy, 0)
}
else {
posy <- c(posy, posy[i-1] - 1)
}
lastChangePosy = DiffFair[i]
# Compute PNL and delete the target profit and buy price from the vectors
PNL = PNL + (DiffFair[i] - tail(buyPrices, n=1))
buyPrices <- buyPrices[-length(buyPrices)]
targetProfit <- targetProfit[-length(targetProfit)]
steps <- steps[-length(steps)]
if (DiffFair[i] > -10) {
firstPosy = FALSE
}
}
# Posy doesn't change
else {
posy <- c(posy, posy[i-1])
}
}
print(PNL)

Function using ifelse not returning a vector in R

I wrote a somewhat grotesque function, which should simply return a vector with two values.
For example, if you put in 33, you should get back c(30, 40).
It couldn't get much simpler than this.
return_a_range <- function(number){
ans <- ifelse( (30 <= number & number <= 40), c(30, 40),
(ifelse( (40 < number & number <= 50), c(40, 50),
(ifelse( (50 < number & number <= 60), c(50, 60),
(ifelse( (60 < number & number <= 70), c(60, 70),
(ifelse( (70 < number & number <= 80), c(70, 80),
(ifelse( (80 < number & number <= 100), c(80, 100),
ans <- c("NA"))))))))))))
return(ans)}
return_a_range(33)
Why is this returning only 30? How am I not getting back c(30, 40)? Why did R decide to only return the value in the first position of the vector?
EDIT
Although most of the responses are concerned with (justifiably!) spanking me for writing a lousy ifelse statement, I think the real question was recognized and answered best by #MrFick in the comments directly below.
You could just use:
> c(floor(33 / 10), ceiling(33 / 10))*10
[1] 30 40
Or as a function - thanks to #Khashaa for a nice modification (in the comments):
f <- function(x) if(abs(x) >= 100) NA else c(floor(x / 10), floor(x/10) + 1)*10
f(44)
#[1] 40 50
f(40)
#[1] 40 50
This kind of functions will be a lot more efficient than multiple nested ifelses.
I overlooked initially that you want to return 30 - 40 for a input value of 40 (I thought you wanted 40 - 50 which is what the above function does).
So this is a slightly more elaborate function which should implement that behavior:
ff <- function(x) {
if (abs(x) >= 100L) {
NA
} else {
y <- floor(x / 10L) * 10L
if (x %% 10L == 0L) {
c(y - 10L, y)
} else {
c(y, y + 10L)
}
}
}
And in action:
ff(40)
#[1] 30 40
ff(45)
#[1] 40 50
Or if you had a vector of numbers you could lapply/sapply over it:
( x <- sample(-100:100, 3, F) )
#[1] 73 89 -97
lapply(x, ff)
#[[1]]
#[1] 70 80
#
#[[2]]
#[1] 80 90
#
#[[3]]
#[1] -100 -90
Or
sapply(x, ff)
# [,1] [,2] [,3]
#[1,] 70 80 -100
#[2,] 80 90 -90
Here's another variation using %/% which will work for f2(40) case too (but my fail somewhere else?)
f2 <- function(x) if(abs(x) >= 100) NA else c(x %/% 10, (x + 10) %/% 10) * 10
f2(40)
## [1] 40 50
If you really want to use your function the way you use it and not go with docendo's answer (where for this problem I don't see why) you can do the following (in case you need to do something similar in the future):
return_a_range <- function(number){
ans <- ifelse( (30 <= number & number <= 40), a<-c(30, 40),
(ifelse( (40 < number & number <= 50), a<-c(40, 50),
(ifelse( (50 < number & number <= 60), a<-c(50, 60),
(ifelse( (60 < number & number <= 70), a<-c(60, 70),
(ifelse( (70 < number & number <= 80), a<-c(70, 80),
(ifelse( (80 < number & number <= 100), a<-c(80, 100),
a <- c("NA"))))))))))))
return(a)}
> return_a_range(33)
[1] 30 40
> return_a_range(62)
[1] 60 70
The only thing I did was to save the vector in a variable a on each ifelse.

Round up numbers so it is divisible by m (in R)

What is the easiest way to round up x so that it is divisible by m ?
For example,
if x = 114, m =4, then the round up should be 116
or
if x = 119, m=5, then the round up should be 120
roundUp <- function(x,m) m*ceiling(x / m)
roundUp(119,5)
roundUp(114,4)
Divide the number by the require multiple, round the result to the next integer and multiply again by the required multiple.
E.g.: 116 / 5 = 23.1, round to 24, 24 ยท 5 = 120
Use modulo (%%):
roundUP <- function(x, m){x + m - x %% m}
roundUP(114, 4)
[1] 116
roundUP(119, 5)
[1] 120
roundUP(118, 5)
[1] 120
roundUP(113, 5)
[1] 115

Resources