I am defining an S4 function class to ensure the length of the output equals the length of the input (sort of one-to-one, but not in the calculus sense), e.g.
EqLenOut <- setClass("EqLenOut", contains = "function")
.EqLenOut.validity <- function(object) {
msg <- NULL
if (length(formals(object)) > 1) {
msg <- c(msg, "EqLenOut must only have one argument.")
}
tst1 <- length(object(1:5)) != 5
tst2 <- length(object(1:6)) != 6
if (tst1 || tst2) {
msg <- c(msg, "EqLenOut output length must equal input length.")
}
msg
}
S4Vectors::setValidity2("EqLenOut", method = .EqLenOut.validity)
It works, but it is imperfect to test the function for two arbitrary numeric inputs. In my particular case, I will also be requiring numeric inputs & outputs. However, it would be nice to setup a general "equal-output" class that both equal output numeric or non-numeric functions could contain.
How to best (rigorously & efficiently) test if a function output length equals the input length, regardless of the input/output?
If there is a name for classes of functions that take an n-length input vector and return an n-length output vector, I would love to make the question title more specific.
Related
I have written a custom function that performs a mathematical transformation on a column of data with the inputs being the data and one other input (temperature). I would like to have 2 different logical checks. The first one is whether or not any values in the column exceed a certain threshold, because the transformation is different above and below the threshold. The second is a check if the temperature input is above a certain value and in that case, to deliver a warning that values above the threshold are unusual and to check the data.
Right now, I have the function written with a series of if/else statements. However, this a warning that it is only using the first element of the string of T/F statements. A simplified example of my function is as follows:
myfun = function(temp,data) {
if(temp > 34){
warning('Temperature higher than expected')
}
if (data > 50) {
result = temp*data
return(result)
} else if(data <= 50) {
result = temp/data
return(result)
}
}
myfun(temp = c(25,45,23,19,10), data = c(30,40,NA,50,10))
As you can see, because it is only using the first value for the if/else statements, it does not properly calculate the return values because it doesn't switch between the two versions of the transformation. Additionally, it's only checking if the first temp value is above the threshold. How can I get it to properly apply the logical check to every value and not just the first?
-edit-simplified the function per #The_Questioner's suggestion and changed < 50 to <= 50.
The main issue with your code is that you are passing all the values to the functions as vectors, but then are doing single element comparisons. You need to either pass the elements one by one to the function, or put some kind of vectorized comparison or for loop into your function. Below is the for loop approach, which is probably the least elegant way to do this, but at least it's easy to understand what's going on.
Another issue is that NA's apparently need to be handled in the data vector before passing to any of your conditional statements, or you'll get an error.
A final issue is what to do when data = 50. Right now you have conditional tests for greater or less than 50, but as you can see, the 4th point in data is 50, so right now you get an NA.
myfun = function(temp,data) {
result <- rep(NA,length(temp))
for (t in 1:length(temp)) {
if(temp[t] > 34) {
warning('Temperature higher than expected')
if (!is.na(data[t])) {
if (data [t] > 50) {
result[t] <- temp[t]*data[t]
} else if(data[t] < 50) {
result[t] <- temp[t]/data[t]
}
}
} else {
if (!is.na(data[t])) {
if (data[t] > 50) {
result[t] <- temp[t]*data[t]
} else if(data[t] < 50) {
result[t] <- temp[t]/data[t]
}
}
}
}
return(result)
}
Output:
> myfun(temp = c(25,45,23,19,10), data = c(30,40,NA,50,10))
[1] 0.8333333 1.1250000 NA NA 1.0000000
Please, I am trying to print a message based on an entry of a user.
I am studying for a test and I want to create a function that If I type an specific article( variable character) It will check over a set of vectors and print a message.
ExpfromUS <- function(x){
x <- readline("Check if your articles could be import or export to US. Entry the type of article that you want to ship: ")
a <- c(x == CBOExUS)
b <- c(x == RQSVExUS)
e <- c(x == NATExUS)
for ( i in length(a == TRUE)){
if (a[i] == TRUE){
print("Ok, but just with Contractual basis only");
break; }
else{ for (i in length(b)){
if (b[i] == TRUE){
print("Ok, but with restrictions of quantity, size or value");
break;}
else{ for (i in length(c)){
if (e[i] == TRUE){
print("Sorry, but we are not able to ship your cargo at this moment");
break;}
else{ print("Please check your entry we could not find this article in our database")
}}
}
}
}
}
}
But always print the last message "Please check your entry we could not find this article in our database", what am I doing wrong? (Sorry this is a beginner level doubt).
Thanks for all who spend their time helping me.
Expanding my comment: I suspect that your indexing for all the for loops is (part) the problem. The current indexing is only going to cause one iteration since length(a == TRUE) will return a single integer. I suspect you wanted the numeric values where "a == TRUE" so you could output a message at that row. The which function returns numeric values corresponding to the index of "TRUE" values of a logical vector, so perhaps you wanted:
for ( i in which(a) ){
....}
else{ for (i in which(b)){
...}
else{ for (i in which(c)){
....}
Further note: When working with logical vectors it is rarely necessary to include == TRUE and is sometimes going to return unexpected results when the vector includes NA's, since NA is never == to anything.
Given what you have offered as values for those three vectors I now thin it should have been
{....
a <- x %in% CBOExUS # the c() not needed. This returns a logical vector
b <- x %in% RQSVExUS
e <- x %in% NATExUS
.....
THe %in% function allows you to test for multiple values. The == function is asking if there is complete equality, obviously unlikely. There still may these correction be other flaws, but we're still without a [MCVE] and so we still won't be able to offer tested coding.
I am trying to make a function which gets few inputs. I would like to know how to check the availability of my arguments . Here is my function:
MyFunction<-function(data,window,dim,option) {
}
First, I want to see if there is any argument , if no, print an error
is it correct to use
if ~nargin
error('no input data')
}
Then, I want to make sure that the second argument is also inserted
is it right to ask like this
if nargin < 2
error('no window size specified')
}
Then, I want to check if the third argument is empty , set it as 1
if nargin < 3 || isempty(dim)
dim<-1
}
you can use hasArg()
testfunction <- function(x,y){
if(!hasArg(x)){
stop("missing x")
}
if(!hasArg(y)){
y = 3
}
return(x+y)
}
>testfunction(y=2)
Error in testfunction(y = 2) : missing x
> testfunction(x=1,y=2)
[1] 3
> testfunction(x=1)
[1] 4
As #Ben Bolker said , missing is used to test whether a value was specified as an argument to a function. You can have different conditions in your R functions such as warning or stop.
In your case, I would do the following
MyFunction<-function(data,window,dim,option) {
if (missing(data))
stop("the first argument called data is missing")
if (missing(window))
stop("the second argument called window is missing")
if (missing(dim))
dim <- 1
if (missing(option))
stop("the second argument called option is missing")
}
I am checking the input of a matrix is reciprocal in R, i.e. value on one side is = to 1/value..
So far I have..
AHP <- function(pairwisematrix){
## check the input data
if (!((is.matrix(pairwisematrix) || (is.data.frame(pairwisematrix)))))
stop("pairwise matrix must be a matrix or a data frame")
if (!(nrow(pairwisematrix) == ncol(pairwisematrix)))
stop("pairwise matrix must be a square matrix or a data frame")
for (i in 1:nrow(pairwisematrix)) {
for (j in 1:ncol(pairwisematrix)) {
if (i == j) { if (pairwisematrix[i,j] != 1) { stop("the central values in the reciprocal matrix must be 1.") }}
else { if ((pairwisematrix[i,j] == 1 / pairwisematrix[j,i]) || (pairwisematrix[j,i] == 1 / pairwisematrix[i,j])))) { stop("the pairwise matrix must be reciprocal (i.e. value on one side must = 1/value)") }}
}
}
out <- "all worked"
return(out)
}
but when I test:
check1 <- matrix(c(1,1/3,5,3,1,0.2,0.2,5,1),3,3,byrow=T)
test <- AHP(check1)
I get the error:
the pairwise matrix must be reciprocal (i.e. values on one side must =
1/value)0.333333 & 0.333333
I have tried converting the values to string, partial strings and tried identical(a,b,) with no success.
Does anyone have any ideas?
With many if s inside double for loops, I would be surprised if it works as intended.
R is designed for working with matrix, so you could write something like
AHP <- function(pairwisematrix){
if(!all(pairwisematrix == t(1/pairwisematrix)))
stop("the pairwise matrix must be reciprocal (i.e. value on one side must = 1/value)")
else
return("all worked")
}
AHP(check1)
#[1] "all worked"
I want to define an S4 method that return a scalar return value. Here I mean by scalar value , the contrary of a vector.
setGeneric("getScalar", function(value, ...)
standardGeneric("getScalar")
)
setMethod("getScalar",
signature(value = "ANY"),
def = function(value, ...) getScalar(value,...), ## call external function
valueClass = "atomic" ### atomic is false, what should I do ?
)
I can't override the method by its output , I mean I can't define many function having the same signature with a different return valueClass :numeric , integer , character ,..
So How can I do this?
EDIT to give more context :
I think is atomic is confusing here. I mean by scalar a numeric value or a boolean or a character, of length one. To give more context I will have 3 functions in my package:
dbGetQuery :return a list/data.frame : i.e some table rows
dbGetScalar :return a scalar value : i.e count(*),table_name,..
dbGetNoQuery :return nothing : update/insert actions
It is an extension to DBI interface.
EDIT2
We can assume that scalar is a vector of length 1. But I can't express this condition using S4. in c# or c, I would write
double[] // vector
double // scalar
Maybe I should just change the name of my function.
One possibility is to check the value of the return type after method dispatch
setGeneric("getScalar", function(x, ...) {
value <- standardGeneric("getScalar")
if (!is.atomic(value) || length(value) != 1L)
stop("not a scalar atomic vector")
value
})
setMethod(getScalar, "ANY", function(x, ...) x)
Another possibility is to define a 'Scalar' class, with a validity check on the base class that enforces the constraint
.Scalar <- setClass("Scalar", contains="ANY", validity=function(object) {
if (length(object) != 1L)
"non-scalar object"
else TRUE
}, prototype=NA)
or controlling scalar types more strongly with a small hierarchy based on a virtual class
setClass("Scalar", validity=function(object) {
if (length(object) != 1L)
"non-scalar object"
else TRUE
})
.ScalarInteger <- setClass("ScalarInteger",
contains=c("Scalar", "integer"),
prototype=prototype(NA_integer_))
This is the approach taken in Bioconductor's Biobase package, with a mkScalar constructor.