simultaneously printing a message and capturing it - r

Let's say I have a function like the following that only shows a message.
foo <- function(x) {
if (x < 0) message("entered number is negative")
}
Now I want to do something depending on whether the message was shown or not. To this end, I can use capture.output, which will capture the message.
But the problem is that the first message will no longer be shown to the user:
foo(-5)
#> entered number is negative
foo_new <- function(x) {
if (x < 0) m <- capture.output(message(cat("entered number is negative")))
if (length(m) > 0) return("think of a positive number")
}
foo_new(-2)
#>
#> [1] "think of a positive number"
Is there alternative to capture.output which capture the message and also prints it simultaneously?
P.S. This is just a minimal example demonstrating the problem.

You could also use the tee-operator %T>% from the magrittr library:
library(magrittr)
foo_new <- function(x) {
if (x < 0) m <- "entered number is negative" %T>% print()
if (length(m) > 0) return("think of a positive number")
}
foo_new(-2)
[1] "entered number is negative"
[1] "think of a positive number"
Here is more information on the tee-operator and how it works.

Given the code in the question this example is too complicated but the point it tries to make is the following:
If instead of giving a message, the message is first assigned to a variable then that variable can be returned to caller. This has the advantage of making it possible to create a message depending on the exact conditions it came to be needed.
foo <- function(x) {
xname <- deparse(substitute(x))
if(is.numeric(x)){
if(x < 0){
msg <- paste("entered number", sQuote(xname), "is negative")
message(msg)
msg
} else {
2*x
}
} else {
msg <- paste("Wrong class:", sQuote(xname), "is not numeric")
message(msg)
msg
}
}
x <- 1
y <- -2
z <- "1"
foo(x)
#[1] 2
foo(y)
#entered number ‘y’ is negative
#[1] "entered number ‘y’ is negative"
foo(z)
#Wrong class: ‘z’ is not numeric
#[1] "Wrong class: ‘z’ is not numeric"

Related

My R function doesn't seem to be using the arguments I give it

I have created an R function that doesn't seem to be using the arguments that I give it. It runs but the result is not the one I should be getting given the parameters I pass to it. The code I have is as follows:
test_function <- function(text1, text2, number1) {
if (length(text1) == length(text2)) {
print("Equal")
} else {
print("Not equal")
}
operation <- length(text1) + number1
print(paste("The result for the operation is: "), operation)
}
x <- "Hello"
y <- "World!"
z <- 10
test_function(x, y, z)
Does anyone know why the result I'm getting is the following?
[1] "Equal"
[1] "The result for the operation is: "
Use nchar() instead of length().
In addition, paste("The result for the operation is:", operation).
test_function <- function(text1, text2, number1) {
if (nchar(text1) == nchar(text2)) {
print("Equal")
} else {
print("Not equal")
}
operation <- nchar(text1) + number1
print(paste("The result for the operation is:", operation))
}
x <- "Hello"
y <- "World!"
z <- 10
test_function(x, y, z)
#[1] "Not equal"
#[1] "The result for the operation is: 15"

How do I validate a user input for conditions using grepl

I am trying to stick to base R as a personal challenge. I'm not committed to using grepl though, it was just my first thought. And I've hit a roadblock.
Here is what I have so far:
armstrong <- function(x) {
if (grepl("^[-]{0,1}[0-9]{0,}.{0,1}[0-9]{1,}$", x) == FALSE) {
stop("Please try submitting a valid number")
}
else {
temp <- strsplit(as.character(x), split = "")
y <- sapply(temp, function(y)sum(as.numeric(y)^length(y)))
if (y == x) {
print(paste("The number you entered,", x ,", is an Armstrong number"))
}
else {
print(paste("The number you entered,", x ,", is not an Armstrong number"))
}
}
}
armstrong(readline(prompt = "Please enter a three digit positive number"))
The program checks to see if the user inputted an Armstrong number. That part works. What I'm stuck on is the error handling for the user input. I can't get grepl to output FALSE if the user inputs a negative number, or if they input characters in between numbers, such as 1a4. It would be nice if grepl would output FALSE is the user inputs a number that isn't 3 digits, but that's not such a big deal because the function will still work.
How do I update the regular expressions to help with error handling?
Why not just
if (! is.numeric(x) || x < 0) stop(…)
In other words: use proper types. Don’t accept a string if the input is supposed to be a number.
If you are required to accept a string, convert that string to a number and test whether the conversion succeeded. You can test for NA to check if it was successful.
I’d also suggest a few other changes to the function:
armstrong <- function (x) {
num <- as.numeric(x)
if (is.na(num) || num < 0) stop("Please try submitting a valid number")
digits <- strsplit(x, "")[[1L]]
sum <- sum(as.numeric(digits) ^ length(digits))
msg <- paste0(
"The number you entered, ", x, ", is ",
if (num != sum) "not " else "",
"an Armstrong number"
)
message(msg)
}

Why are For Loops Not Effective in R and Looping Through Indices

I am doing R practice exercises from the R-bloggers site. This is the problem I was working on:
Create a function that will return TRUE if a given integer is inside a vector.
The solution code provided is:
f.exists <- function (v, x) {
exist <- FALSE
i <- 1
while (i <= length (v) & !exist) {
if (v[i] == x) {
exist <- TRUE
}
i <- 1 + i
}
exist
}
However, my attempt was:
isInside <- function(x, y) {
i <- 1
for (i in x) {
print(i)
if (x[i] == y) {
return(TRUE)
}
else {
return(FALSE)
}
}
}
test <- c(1,2,3,4,5,6,7,8,9,10,10.25,100)
isInside(test,10.25)
This returns [1] 1 [1] False meaning it only looped through once and exited once it hit false. It should have returned true though, since 10.25 is in the vector x. I am not sure why the if statement does not work since it should loop through each index of x to see if the number is in the vector.
Additionally, I found on this post, that says you should use while loops rather than for loops. Why are for loops such bad practice? And is there something inherently wrong with my for loop that makes it not work?
Dodging the preferred use of R's %in% inline operator, let's analyze your function.
for (i in x) is stepping through each value of x. This means that on the 11th pass through a loop like this (lacking interruption), i would be 10.25 and not 11. This will fail logically when you reference x[i]: it won't throw an error (which I believe is a failure of R, to be honest), but it makes no sense (what is x[10.25]? what should the next pass of x[100] return?). This should either be for (i in seq_along(x)) or stick with for (i in x) and later replace x[i] == y with i == y.
You choose to return(TRUE) when a match is found. The return function immediately breaks out of the for loop and out of the function, returning the value TRUE. If the match is not found, you return(FALSE), which also immediately breaks out of the for loop and the function, returning the value FALSE. I think what you intend is for the loop to continue, so the else clause of the if statement is ... unnecessary. If you remove the else statement, perhaps it'll work better.
Minor, you pre-defined i <- 1. This hurts or changes nothing, but it is completely unnecessary in R. i is not referenced outside of the loop, and as soon as for starts, i is assigned the first value of x. Therefore, you can safely remove i <- 1 and execution should be unaffected. (This is not code style, it's just unnecessary code.)
Demonstration of one method:
myany <- function(x, y) {
for (el in x) {
if (el == y) {
return(TRUE)
}
}
return(FALSE)
}
test <- c(1,2,3,4,5,6,7,8,9,10,10.25,100)
myany(test, 10.25)
# [1] TRUE
Alternatively,
myany <- function(x, y) {
for (ind in seq_along(x)) {
if (x[ind] == y) {
return(TRUE)
}
}
return(FALSE)
}
We can see some of the mistakes in this example:
myany <- function(x, y) {
for (i in x) {
message("Comparing ", sQuote(i), " (which is ", sQuote(x[i]), ") with ", sQuote(y))
if (x[i] == y) {
return(TRUE)
}
}
return(FALSE)
}
myany(test, 10.25)
# Comparing '1' (which is '1') with '10.25'
# Comparing '2' (which is '2') with '10.25'
# Comparing '3' (which is '3') with '10.25'
# Comparing '4' (which is '4') with '10.25'
# Comparing '5' (which is '5') with '10.25'
# Comparing '6' (which is '6') with '10.25'
# Comparing '7' (which is '7') with '10.25'
# Comparing '8' (which is '8') with '10.25'
# Comparing '9' (which is '9') with '10.25'
# Comparing '10' (which is '10') with '10.25'
# Comparing '10.25' (which is '10') with '10.25'
# Comparing '100' (which is 'NA') with '10.25'
# Error in if (x[i] == y) { : missing value where TRUE/FALSE needed
Here's where we see what is happening. When i is 10, it looks fine, as the 10th element of test is indeed 10. However, in the next pass, i is 10.25 instead of your expected 11. R is silently truncating x[10.25] into x[10], which is why it says which is '10', since the 10th element is indeed 10. The next pass is where i is 100, and test[100] clearly does not exist. In R, when you try to retrieve an index that is outside of the defined length of a vector, it will return NA (other languages give an error or core dump when you attempt this).
There are several issues here. As pointed out by r2evans, your loop is exited at the first iteration because of your code. It must return TRUE or FALSE at the first iteration.
Besides, your loop will not work due to a simple mistake: for (i in x) cannot work as x should evaluate to a vector of integers. You are looking for: for (i in 1:length(x)).
> for (i in test) {print(i)}
[1] 1
[1] 2
[1] 3
[1] 4
[1] 5
[1] 6
[1] 7
[1] 8
[1] 9
[1] 10
[1] 10.25
[1] 100
At the 11th iteration R interprets 10.25 as 10 so you are lucky. At the 12th loop, the code would look for the 100st element in test and NA is returned.
There is a much simpler solution without a loop by using the inherent vectorisation of some R functions:
test <- c(1,2,3,4,5,6,7,8,9,10,10.25,100)
x <- 10.25
any(test == x)
will return:
> any(test == x)
[1] TRUE
And if you would like to know which element:
> which(test == x)
[1] 11
As a function:
isInside <- function(x, v) return(any(x == v))
isInside(test, 10.25)
returns:
> isInside(test, 10.25)
[1] TRUE
> isInside(test, 11)
[1] FALSE

Can an R function behaiviour change depending of number of arguments received?

So far I have created a function that can change its behaiviour depending on whether it receives a number or a character as input, a minumal example could be the following:
...
f <- function(x)
UseMethod("g")
f.numeric <- function(x)
return(x^2)
f.character <- function(x)
return("Hey, dude. WTF are you doing? Don't give me characters!")
...
Now assume that I want f to be able to receive two numbers as input and return its sum, without losing the previous functionality. How can I achieve that?.
Could rewrite the function to do the checks yourself? e.g...
f <- function(x, y=NA){
if (all(is.numeric(c(x,y))) & !is.na(y)){
return(x+y)
}else if(is.numeric(x)){
return(x^2)
}else if(is.character(x)){
return("Hey, dude. WTF are you doing? Don't give me characters!")
}else{
return("Hey, dude. I don't know what you are giving me?!")
}
}
With ellipsis this is easily possible:
f <- function(x,...)
{
if(missing(...))
{
if(is.numeric(x)) return(x^2)
if(is.character(x)) return("Hey, dude. WTF are you doing? Don't give me characters!")
}else
{
if(any(is.character(c(x,...))) return("Hey, dude. WTF are you doing? Don't give me characters!"))
return(x+..1)
}
}
> f("foo")
[1] "Hey, dude. WTF are you doing? Don't give me characters!"
> f(4)
[1] 16
> f(4,5)
[1] 9
Not sure if this is what you need, but maybe it helps :)
sum_them <- function(var1, var2, na.rm = F)
{
if(all(is.numeric(c(var1, var2)))) return(sum(c(var1, var2), na.rm = na.rm))
return("non numeric argument")
}
sum_them("test", "this")
sum_them("test", 10)
sum_them(5, "this")
sum_them(5, 10)
sum_them(NA, 10)
sum_them(NA, 10, na.rm = T)
Output
> sum_them("test", "this")
[1] "non numeric argument"
> sum_them("test", 10)
[1] "non numeric argument"
> sum_them(5, "this")
[1] "non numeric argument"
> sum_them(5, 10)
[1] 15
> sum_them(NA, 10)
[1] NA
> sum_them(NA, 10, na.rm = T)
[1] 10
Updated function, since i didn't get the do something different if it is just 1 number.
Logic behind:
if there is just 1 paramter (var1) do whatever you like whit it, but trycatch in case it is a no nummeric.
If all param are numeric, sum them up.
else return some string.
sum_them <- function(var1, ..., na.rm = F)
{
if(missing(...)) tryCatch({var1 <- var1^2}, warning = function(w){}, error = function(e){})
if(all(is.numeric(c(var1, ...)))) return(sum(c(var1, ...), na.rm = na.rm))
return("non numeric argument")
}
new output:
> sum_them("test", "this")
[1] "non numeric argument"
> sum_them("test", 10)
[1] "non numeric argument"
> sum_them(5, "this")
[1] "non numeric argument"
> sum_them(5, 10)
[1] 15
> sum_them(NA, 10)
[1] NA
> sum_them(NA, 10, na.rm = T)
[1] 10
> sum_them(NA, na.rm = T)
[1] 0
> sum_them(10, na.rm = T)
[1] 100
> sum_them(10)
[1] 100
> sum_them("test")
[1] "non numeric argument"
> sum_them(10,10,10,10, NA)
[1] NA
> sum_them(10,10,10,10, NA, na.rm = T)
[1] 40
> sum_them(10,10,10,test, NA, na.rm = T)
[1] "non numeric argument"
If what you're looking for is something like C's method signatures[1], then no, I'm not aware that R has anything of that nature.
The closest I'm aware of in R is that you have a "super-function" that accepts all of the arguments and then a set of sub-functions to which the super-function distributes. For example, consider (what I've outlined below isn't functionally different than Julian_Hn's answer. The difference between using ellipses and explicitly naming the arguments is the amount of control over what they user can pass to the function. If you use ellipses, your test for the existence of the argument will look different)
super_function <- function(x = NULL, y = NULL){
if (!is.null(x) & is.null(y)){
if (is.character(x)){
sub_function_xchar(x)
} else if {
(is.numeric(x)){
sub_function_xnum(x)
}
} else {
sub_function_xelse(x)
}
} else {
if (!is.null(x) & !is.null(y)){
if (is.character(x) & is.character(y)){
sub_function_xychar(x, y)
} else {
# Okay, I think you might get the point now
}
}
}
}
sub_function_xchar <- function(x){
# whatever you want to do with x as a character
}
sub_function_xnum <- function(x){
# whatever you want to do with x as a numeric
}
sub_function_xelse <- function(x){
# whatever you want to do with any other class of x
}
sub_function_xychar <- function(x, y){
# whatever you want to do with x and y as characters
}
Yes, it's messy. I've used approaches like this with success for small sets of arguments. I don't know that I'd recommend it for large sets of arguments. Instead, if you have a lot of arguments, I'd recommend finding ways to break whatever task you're intending into smaller chunks that can each be isolated to their own functions.
[1] Not sure if I got the term right, but the functionality in C that many methods may have the same name, but they must be unique on the collection and type of arguments they accept.
If you want to keep using S3 you could use ...length() (>= R 3.4.2) :
f <- function(...)
UseMethod("f")
f.numeric <- function(...)
if(...length() == 1) ..1^2 else sum(...)
f.character <- function(...)
return("Hey, dude. WTF are you doing? Don't give me characters!")
f(2)
#[1] 4
f(3,4)
# [1] 7

How to check if values in two columns has the same class in R?

I have to check if a value in two columns or lists has the same class. I wrote the following codes but none are working because just write the last value on the list but not only the first values.
My lists
x <- c(1,3,6,2) ## All are numeric
y <- c(6,4,3,'a') ## Note that is a string at here
m <- NULL
Code 1
for (i in length(x)) {
if (class(x[i]) == class(y[i])) m[i] <-'ok' else m[i] <- 'no ok'
}
Code 2
et <-function(x, y){
for (i in length(x)) {
if (class(x[i]) == class(y[i])) {
m[i] = 'ok'
} else {
m[i] = 'not ok'
}
return(f)
}
}
et(x,y)
Thanks for helping.
Your problem is in the for loop call, which is only passing one integer to run, rather than a list of integers, like you're hoping. Change this:
for (i in length(x)) { ...
to this:
for (i in 1:length(x)) { ...
Notice that "length(x)" is 4, whereas "1:length(x)" is all integers 1:4.
If you want to check the class of corresponding elements in two lists, you can use Map function:
x <- list(1,3,6,2)
y <- list(6,4,3,'a')
Map(function(x,y) c("no ok", "ok")[as.integer(class(x) == class(y)) + 1], x, y)
[[1]]
[1] "ok"
[[2]]
[1] "ok"
[[3]]
[1] "ok"
[[4]]
[1] "no ok"
Or mapply which returns a vector:
mapply(function(x,y) c("no ok", "ok")[as.integer(class(x) == class(y)) + 1], x, y)
[1] "ok" "ok" "ok" "no ok"
We can also loop through using lapply/sapply and get a logical output
sapply(seq_along(x), function(i) class(x[[i]])==class(y[[i]]))
data
x <- list(1,3,6,2)
y <- list(6,4,3,'a')

Resources