Can someone tell me what is wrong with this function in R? The functions can work on a single input, but when I use a vector I get an error:
input_check3 <- function(x){
if (is.finite(x)) {
if (x %% 2 == 0){
print(TRUE)
} else {
print(FALSE)
}
} else {
NA
}
}
data_for_e2 <- c(1, 2, 4, 5, 3)
input_check3(data_for_e2)
#> [1] FALSE
#> Warning messages:
#> 1: In if (is.finite(x)) { : The length of the condition is greater than one, so only its first element can be used
#> 2: In if (x%%2 == 0) { : The length of the condition is greater than one, so only its first element can be used
You could use ifelse, which is a vectorized function:
input_check3 <- function(x){
ifelse(is.finite(x),
x %% 2 == 0, # equiv to ifelse(x %% 2 == 0, TRUE, FALSE), thanks Martin Gal!
NA)
}
Result
[1] FALSE TRUE TRUE FALSE FALSE
Related
I was hoping to create a function with the if statements in the following code:
data <- data.frame(
id = c(1, 5, 6, 11, 15, 21),
intervention = c(2, 2, 2, 1, 1, 1),
death = c(0, 1, 0, 1, 0, 0)
)
test <- c()
for (i in data$id[which(data$intervention == 1)]) {
print(paste0("id = ", i, ": "))
for (j in data$id[which(data$intervention == 2)]) {
if (data$death[data$id == i] < data$death[data$id == j]) {
test <- c(test, -1)
} else if (data$death[data$id == i] > data$death[data$id == j]) {
test <- c(test, 1)
} else if (data$death[data$id == i] == data$death[data$id == j]) {
test <- c(test, 0)
}
}
print(test)
test <- c()
}
I had tried to do it as follows, however the code is not writing the result to the vector. However if I replaced the return with print, it would print it out. Would anyone have any suggestions on what I might be doing wrong? Many thanks!
first <- function () {
if(data$death[data$id == i]<data$death[data$id ==j]){
return (test <- c(test,-1))}
else if(data$death[data$id == i]>data$death[data$id == j]){
return (test <- c(test,1))}
else if(data$death[data$id == i]==data$death[data$id == j]){
return (test <- c(test,0))}
}
for (i in data$id[which(data$intervention == 1)]){
for (j in data$id[which(data$intervention == 2)]){
first()
}
test
}
The following function returns a list of the wanted vectors.
first <- function(data, interv1 = 1, interv2 = 2) {
inx <- which(data[["intervention"]] == interv1)
jnx <- which(data[["intervention"]] == interv2)
out <- lapply(inx, \(i) {
sapply(jnx, \(j) sign(data[["death"]][i] - data[["death"]][j]))
})
setNames(out, data[["id"]][inx])
}
first(data)
#> $`11`
#> [1] 1 0 1
#>
#> $`15`
#> [1] 0 -1 0
#>
#> $`21`
#> [1] 0 -1 0
Created on 2022-11-22 with reprex v2.0.2
You can then access the return values as
test <- first(data)
# any of the following extracts the 1st vector
test[['11']]
#> [1] 1 0 1
# notice the backticks
test$`11`
#> [1] 1 0 1
Created on 2022-11-22 with reprex v2.0.2
What I want to do is a function where x is a vector, and y any integer. If y is inside the vector x, then it should return "TRUE". Also, if the vector contains NAs or decimals, then it should print an error message.
So far I have created this, but if I input search(c(9,8,3,NA),3) it gives me this message:
Warning message:
In if (x%%1 != 0 | anyNA(x) == TRUE) { :
the condition has length > 1 and only the first element will be used
If if input a vector with a decimal in it like this search(c(8,9,7.01,12),12)it won't give an ERROR message.
This is my code so far:
search <- function(x,y){
if (x%%1!=0 | anyNA(x)==TRUE){
print("ERROR")
}else{
if(y %in% x){
print(TRUE)
}
else
print(FALSE)
}
}
If you want your function to produce an error, use stop, not print. Any program that relies on the output of the function will otherwise keep running, without noticing anything is wrong. This could make things very hard to debug later. stop throws an error, which can then be handled appropriately. Also, because the function will exit if the condition is met, you don't need an else afterwards: that code will only ever run if the condition isn't met, so the else is redundant.
You can also simplify some of the logic. You don't need if(condition == TRUE), since if(condition) does the same thing. Finally, the construction if(condition){ print(TRUE) } else { print(FALSE) } is logically identical to print(condition)
search <- function(x, y){
if (any(x %% 1 != 0) | anyNA(x) | length(y) != 1) stop("Error")
y %in% x
}
Now try it on test cases:
search(c(1, 3, 5), 3)
#> [1] TRUE
search(c(1, 3, 5), 2)
#> [1] FALSE
search(c(1, 3, NA), 3)
#> Error in search(c(1, 3, NA), 3): Error
search(c(1, 3, 5.1), 3)
#> Error in search(c(1, 3, 5.1), 3): Error
search(c(1, 3, 5), c(1, 3))
#> Error in search(c(1, 3, 5), c(1, 3)): Error
Created on 2020-05-15 by the reprex package (v0.3.0)
Use sum(x %% 1) > 0 to validate x.
search <- function(x,y){
if (sum(x %% 1) | anyNA(x)==TRUE){
stop("ERROR")
}else{
if(y %in% x){
print(TRUE)
}
else
print(FALSE)
}
}
...and the output:
> search(c(9,8,3,NA),3)
Error in search(c(9, 8, 3, NA), 3) : ERROR
> search(c(9,8,3),3)
[1] TRUE
>
> search(c(9,8,3),13)
[1] FALSE
>
Also, it's good practice to use the stop() function to communicate an error within an R function. stop() stops execution of the current expression and executes an error action.
I need to replicate the is.element function in R. I have two vectors and need to compare the values in each where if one matches the other the output is True and False for all others.
Code I've tried that does not quite work:
x <- c(3, 0, -2, 0)
y <- c(-1, 0, 1)
n <- length(x)
answer <- is.logical(x)
for (i in 1:n) {
if (x[i] == y[i]) {
answer[i] <- TRUE
} else {
answer[i] <- FALSE
}
}
answer
Intended answer:
[1] FALSE TRUE FALSE TRUE
An option would be outer to do the comparison of each element of 'x' with 'y' to return a logical matrix, which can be reduced to a logical vector
by getting the sum of TRUE elements in each row (rowSums) and check if it is greater than 0
rowSums(outer(x, y, `==`)) > 0
#[1] FALSE TRUE FALSE TRUE
Or create the logical matrix with sapply and do a `colSums
colSums(sapply(x, `==`, y)) > 0
actually, I just figured it out. Thanks again.
x <- c(3, 0, -2, 0)
y <- c(-1, 0, 1)
n <- length(x)
m <- length(y)
answer <- is.logical(x)
for (i in 1:n) {
for (j in 1:m) {
if (x[i] == y[j]) {
answer[i] <- TRUE
break
} else {
answer[i] <- FALSE
}
}
}
answer
I have the following function
aa<-function(x){
if (x==c(3,4,5))
return (1)
if (x==c(6,7,8))
return(2)
else
return(0)
}
I then try the following:
> `aa(3)`
[1] 1
> `aa(4`)
[1] 0
> `aa(5)`
[1] 0
> `aa(6)`
[1] 2
> `aa(7)`
[1] 0
> `aa(8)`
[1] 0
I don't know why only aa(3) and aa(6) gives me the desired outcome, while aa(4) and aa(5) won't return 1 and aa(7) and aa(8) won't return 2. How can I correct my code so that a value of either 3, 4, or 5 returns 1, and 6, 7, or 8 returns 2, and 0 otherwise?
For membership tests, use %in%, not ==. Look at the difference in the R console:
> 3 == c(3,4,5)
[1] TRUE FALSE FALSE
> 3 %in% c(3,4,5)
[1] TRUE
Why? ... you ask. You should have seen a warning message ( two of them in fact) that you didn't tell us about.
> aa(4)
[1] 0
Warning messages:
1: In if (x == c(3, 4, 5)) return(1) :
the condition has length > 1 and only the first element will be used
2: In if (x == c(6, 7, 8)) return(2) else return(0) :
the condition has length > 1 and only the first element will be used
The if statement was handling the results of the x == c(3, 4, 5) and x == c(6, 7, 8) operations, each of which returned a 3-element logical vector. The if()-function only wants a single value and issues a warning if it gets more, telling you that only the first item was used.
There are several ways to handle this. The %in% infix function is one and you could also use either match() or any() to deliver a single result back to the if() function:
aa<-function(x){
if (match(x, c(3,4,5)) ) # match returns a location; any value > 0 will be TRUE
return (1)
if (match(x, c(6,7,8)) )
return(2)
else
return(0)
}
Or:
aa<-function(x){
if ( any( x==c(3,4,5)) ) # a single logical TRUE if any of the "=="-tests are TRUE.
return (1)
if ( any( x==c(6,7,8)) )
return(2)
else
return(0)
}
aa(4)
[1] 1
This will do the trick
aa<-function(x){
if (x==3|x==4|x==5){
return (1)}
else if (x==6|x==7|x==8){
return(2)}
else{
return(0)}
}
Then I have
aa(4)
[1] 1
Note that | is the "or" operator
I want to have a function where for a particular exceptions it throws and return a message, and then simply check whether what is returned is one of my defined 'exceptions'. For example say I have the function:
divideByX <- function(x){
# If x is NA throws exception
if(is.na(x)){
return(exception('x is NA'))
}
# If x is 0 throws exception
else if(x == 0){
return(exception('Cannot divide by zero'))
}
else{
return(10/x)
}
}
So if x is 0 it returns the expception 'Cannot divide by zero', if x is NA it returns the exception 'x is NA' and for all other values of x it tries to evaluate the expression 10/x.
Then I would want to run something like this:
tempList <- list('a' = 2, 'b' = 0, 'c' = 5, 'd' = NA)
lapply(tempList, function(x){
if(is.exception(x)){
return(x)
}
else{
y <- divideByX(x)
return(y^2)
}
})
So it first checks if the value is one of my defined exceptions and if so returns the message, else it squares my value, so the above should return
$a
[1] 25
$b
[1] 'Cannot divide by zero'
$c
[1] 4
$d
[1] 'x is NA'
Does anyone know the best way to do this? Please let me know if anything is unclear.
Thanks in advance
Create a function to generate exceptions. The exceptions can be a linear hierarchy that extends the simple error class
exception <-
function(class, msg)
{
cond <- simpleError(msg)
class(cond) <- c(class, "MyException", class(cond))
stop(cond)
}
Here's your function
divideByX <- function(x){
# If x is 0 throws exception
if (length(x) != 1) {
exception("NonScalar", "x is not length 1")
} else if (is.na(x)) {
exception("IsNA", "x is NA")
} else if (x == 0) {
exception("DivByZero", "divide by zero")
}
10 / x
}
and use to generate the output you asked for
lapply(tempList, function(x) tryCatch({
divideByX(x)
}, MyException=function(err) {
conditionMessage(err)
}))
or to treat some exceptions differently from others
> lapply(list(NA, 3:5), function(x) tryCatch({
+ divideByX(x)
+ }, IsNA=function(err) {
+ warning(err) # signal a warning, return NA
+ NA
+ }, NonScalar=function(err) {
+ stop(err) # fail
+ }))
Error: x is not length 1
In addition: Warning message:
x is NA
Unless you are always dividing 10, you would want to include the numerator in yoru function.
divideByX <- function(X, num=10) {
if(is.na(X))
return('X is NA')
if(X == 0)
return('Cannot divide by zero')
return(num / X)
}
usage:
y <- 3
lapply(tempList, divideByX, num=y^2)
# $a
# [1] 4.5
#
# $b
# [1] "Cannot divide by zero"
#
# $c
# [1] 1.8
#
# $d
# [1] "X is NA"