Related
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
I have a vector of numbers
f <- c(1, 3, 5, 8, 10, 12, 19, 27)
I want to compare the values in the vector to another number, and find the closest smaller value.
For example, if the input number is 18, then the closest, smaller value in the vector is 12 (position 6 in the vector).
If the input is 19, then the result should be the value 19, i.e. the index 7.
I think this answer is pretty straightforward:
f <- c(1,3,6,8,10,12,19,27)
x <- 18
# find the value that is closest to x
maxless <- max(f[f <= x])
# find out which value that is
which(f == maxless)
If your vector f is always sorted, then you can do sum(f <= x)
f <- c(1,3,6,8,10,12,19,27)
x <- 18
sum(f <= x)
# [1] 6
x <- 19
sum(f <= x)
# [1] 7
Try this (not a perfect solution)
x<-c(1,3,6,8,10,12,19,27)
showIndex<-function(x,input){
abs.diff<-abs(x-input)
index.value<-unique(ifelse(abs.diff==0,which.min(abs.diff),which.min(abs.diff)-1))
return(index.value)
}
showIndex(x,12)
[1] 6
showIndex(x,19)
[1] 7
You could try:
x <- 18
f <- c(1,3,6,8,10,12,19,27)
ifelse(x %in% f, which(f %in% x), which.min(abs(f - x)) - 1)
That way if x is not in f, it will return the nearest previous index. If x is in f, it will return x index.
Another one:
which.min(abs(18 - replace(f, f>18, Inf)))
#[1] 6
f[which.min(abs(18 - replace(f, f>18, Inf)))]
#[1] 12
Or as a function:
minsmaller <- function(x,value) which.min(abs(value - replace(x, x>value, Inf)))
minsmaller(f, 18)
#[1] 6
minsmaller(f, 19)
#[1] 7
There is findInterval:
findInterval(18:19, f)
#[1] 6 7
And building a more concrete function:
ff = function(x, table)
{
ot = order(table)
ans = findInterval(x, table[ot])
ot[ifelse(ans == 0, NA, ans)]
}
set.seed(007); sf = sample(f)
sf
#[1] 27 6 1 12 10 19 8 3
ff(c(0, 1, 18, 19, 28), sf)
#[1] NA 3 4 6 1
In a functional programming style:
f <- c(1, 3, 6, 8, 10, 12, 19, 27)
x <- 18
Position(function(fi) fi <= x, f, right = TRUE)
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.
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
I have two tables.
Both tables have only 1 column.
Both have random integer values between 1 to 1000.
I want to intersect these two tables. The catch is I want to intersect the numbers even if they have a difference of about 10.
1st table -> 5 , 50, 160, 280
2nd table -> 14, 75, 162, 360
Output ->
1st table -> 5, 160
2nd table -> 14, 162
How can I achieve this in R
You could do this with the sapply function, checking if each element of x or y is sufficiently close to some member of the other vector:
x <- c(5, 50, 160, 280)
y <- c(14, 75, 162, 360)
new.x <- x[sapply(x, function(z) min(abs(z-y)) <= 10)]
new.y <- y[sapply(y, function(z) min(abs(z-x)) <= 10)]
new.x
# [1] 5 160
new.y
# [1] 14 162
Here is an approach that uses the outer function (so your 2 tables will need to be reasonably sized):
x <- c(5,50,160,280)
y <- c(999,14,75,162,360)
tmp1 <- outer(x,y, function(x,y) abs(x-y))
tmp2 <- which(tmp1 <= 10, arr.ind=TRUE)
rbind(
x=x[ tmp2[,1] ],
y=y[ tmp2[,2] ]
)
This looks at every possible pair between x and y and computes the difference between the 2 values, then finds those with a difference <= 10.