vectorize a bidimensional function in R - r

I have a some true and predicted labels
truth <- factor(c("+","+","-","+","+","-","-","-","-","-"))
pred <- factor(c("+","+","-","-","+","+","-","-","+","-"))
and I would like to build the confusion matrix.
I have a function that works on unary elements
f <- function(x,y){ sum(y==pred[truth == x])}
however, when I apply it to the outer product, to build the matrix, R seems unhappy.
outer(levels(truth), levels(truth), f)
Error in outer(levels(x), levels(x), f) :
dims [product 4] do not match the length of object [1]
What is the recommended strategy for this in R ?
I can always go through higher order stuff, but that seems clumsy.

I sometimes fail to understand where outer goes wrong, too. For this task I would have used the table function:
> table(truth,pred) # arguably a lot less clumsy than your effort.
pred
truth - +
- 4 2
+ 1 3
In this case, you are test whether a multivalued vector is "==" to a scalar.

outer assumes that the function passed to FUN can take vector arguments and work properly with them. If m and n are the lengths of the two vectors passed to outer, it will first create two vectors of length m*n such that every combination of inputs occurs, and pass these as the two new vectors to FUN. To this, outer expects, that FUN will return another vector of length m*n
The function described in your example doesn't really do this. In fact, it doesn't handle vectors correctly at all.
One way is to define another function that can handle vector inputs properly, or alternatively, if your program actually requires a simple matching, you could use table() as in #DWin 's answer
If you're redefining your function, outer is expecting a function that will be run for inputs:
f(c("+","+","-","-"), c("+","-","+","-"))
and per your example, ought to return,
c(3,1,2,4)
There is also the small matter of decoding the actual meaning of the error:
Again, if m and n are the lengths of the two vectors passed to outer, it will first create a vector of length m*n, and then reshapes it using (basically)
dim(output) = c(m,n)
This is the line that gives an error, because outer is trying to shape the output into a 2x2 matrix (total 2*2 = 4 items) while the function f, assuming no vectorization, has given only 1 output. Hence,
Error in outer(levels(x), levels(x), f) :
dims [product 4] do not match the length of object [1]

Related

What are the rules for threading a function over a vector in R?

I have some code which I call with two vectors of different length, lets call them A and B. However, I wrote the function having in mind a single element of A with the expectation that it will be automatically threaded over A. To be concrete,
A <- rnorm(5)
B <- rnorm(30)
foo <- function(x,B){
sum( cos(x*B) ) # calculate sum_i cos(x*B[i])
}
sum( exp(foo(A,B)) ) # expecting this to calculate the exponent for each A[j] and add over j
I need to get
Σ_j exp( Σ_i cos(A[j]*B[i])
and not
Σ_ij exp(cos(A[j]*B[i])) OR exp(cos(Σ_ij A[j]*B[i]))
I suspect that the last R expression is ambiguous, since the declaration of foo does not know B is always a vector. What are the formal rules and am I right to worry about the ambiguity?
If we want to loop over the 'A', then use sapply , and apply the foo on each of the elements of 'A' with anonymous function call and get the sum of the output vector
sum(exp(sapply(A, function(x) foo(x, B))))
In the OP's example with the expression foo(A, B), the product A*B is computed first, and since the lengths of A and B are unequal, the recycling rule takes priority. There is no error message coming out, just because by pure luck the vector length of one is a multiple of the other.
You can also Vectorize the x input. I think this is what you were expecting. At the end of the day, this will work it's way down to an mappy() implementation which is a multivariate sapply, so probably best to just do it yourself as with the solution from akrun.
foo2 <- Vectorize(foo, "x")
sum(exp(foo2(A, B)))
The "formal rules" as you put them is quite simply how R does help("Arithmetic").
The binary operators return vectors containing the result of the element by element operations. If involving a zero-length vector the result has length zero. Otherwise, the elements of shorter vectors are recycled as necessary (with a warning when they are recycled only fractionally). The operators are + for addition, - for subtraction, * for multiplication, / for division and ^ for exponentiation.
So when you use x*B, it is doing element-wise multiplication. Nothing changes when you pass A into the function instead of x.
Simply go through your lines one at a time.
x*B will be a vector of length max(length(x, B)). When they are not of the same length, R will recycle elements of the shorter vector (i.e., repeat them).
cos(x*B) will be a vector of the same length as step (1), but now the cosine of that value.
sum( cos(x*B) ) will sum that vector, returning a single number.
foo(A,B) does steps (1) through (3), but with your defined A and B. Note that in your example A is recycled 6 times to get to the length of B. In other words, what you entered as A is being used as rep(A, 6) in the multiplication step. Nothing about a function definition in R says that foo(A,B) should be repeated for each element of vector A. So it behaves literally as you wrote it, basically swapping in A for x in the function code.
exp(foo(A,B)) will take the result from foo from step 3 (which is a scalar) and raise it to an exponent.
sum( exp(foo(A,B)) ) does nothing, since step (5) is a scalar, there is nothing to sum.

Need help vectorizing a double for-loop creating a matrix of norms of vector differences in R

I'm trying to figure out how to vectorize the following code block in R:
X is an N x M matrix
centers is a K x M matrix
phi <- matrix(0, nrow(X), nrow(centers))
for(i in 1:nrow(phi)) {
for(j in 1:ncol(phi)) {
phi[i, j] <- norm(as.matrix(X[i, ]) - as.matrix(centers[j, ]), type = 'F')
}
}
I'm constructing an N x K matrix, phi, which at each position, [i, j], contains the norm of the difference between the vectors at row i of X and row j of centers:
phi[i, j] = || X[i, ] - centers[j, ] ||
My approach so far has been to attempt to use R's outer() function. I'm new to the outer() function, so I've searched for several examples, however, the examples I've come across involve using outer() to apply some function to a pair of vectors of scalar values. As I'm dealing with the differences between pairs of rows from two matrices, outer() behaves different than expected. I'm not sure how to get it to recognize the matrices I'm passing it (X and centers) as vectors of vectors, where each row represents a vector to be involved in the computation of phi.
In addition, when I define a function to compute the norm of the difference between two M-length vectors, that function returns a scalar. It is my understanding that in order to vectorize a function using R's Vectorize(), that function must return a result of the same length as its arguments. I'm not sure how to define a function which, when used in conjunction with outer(), recognizes each row of a matrix as a single element (in spite of it being an M-length vector).
Below are a couple of my attempts to use outer() with toy examples of the matrices X and centers.
X <- matrix(c(7,8,9,1,2,3,4,5,6), 3, 3)
centers <- matrix(c(1,2,3,4,5,6), 2, 3)
fun <- function(y, x) norm(as.matrix(y) - as.matrix(x), type = 'F')
outer(X, centers, fun)
This was my first attempt. I was trying to use outer() in a manner analogous to the way it is used when it is passed a pair of vectors. I was (naively) hoping it would take one row from each matrix at a time, pass them as the two arguments to fun, and position the result appropriately in the product matrix. Instead, I get the following error message.
Error in outer(X, centers, fun) :
dims [product 54] do not match the length of object [1]
I also tried vectorizing my function using R's Vectorize() before calling outer().
Vecfun <- Vectorize(fun)
outer(X, centers, Vecfun)
In this case, I no longer get an error message, but the result is an erroneous matrix of matrices. I'm also new to the Vectorize() function, so I'm not too sure why it produces the result that it does as I don't have a real grasp on what it does; using it was sort of a shot in the dark.
I'll appreciate any help in vectorizing my original problem; I'm completely open to suggestions that do not involve outer().
Clarifications regarding outer() and Vectorize() also welcome.

R: passing by parameter to function and using apply instead of nested loop and recursive indexing failed

I have two lists of lists. humanSplit and ratSplit. humanSplit has element of the form::
> humanSplit[1]
$Fetal_Brain_408_AGTCAA_L001_R1_report.txt
humanGene humanReplicate alignment RNAtype
66 DGKI Fetal_Brain_408_AGTCAA_L001_R1_report.txt 6 reg
68 ARFGEF2 Fetal_Brain_408_AGTCAA_L001_R1_report.txt 5 reg
If you type humanSplit[[1]], it gives the data without name $Fetal_Brain_408_AGTCAA_L001_R1_report.txt
RatSplit is also essentially similar to humanSplit with difference in column order. I want to apply fisher's test to every possible pairing of replicates from humanSplit and ratSplit. Now I defined the following empty vector which I will use to store the informations of my fisher's test
humanReplicate <- vector(mode = 'character', length = 0)
ratReplicate <- vector(mode = 'character', length = 0)
pvalue <- vector(mode = 'numeric', length = 0)
For fisher's test between two replicates of humanSplit and ratSplit, I define the following function. In the function I use `geneList' which is a data.frame made by reading a file and has form:
> head(geneList)
human rat
1 5S_rRNA 5S_rRNA
2 5S_rRNA 5S_rRNA
Now here is the main function, where I use a function getGenetype which I already defined in other part of the code. Also x and y are integers :
fishertest <-function(x,y) {
ratReplicateName <- names(ratSplit[x])
humanReplicateName <- names(humanSplit[y])
## merging above two based on the one-to-one gene mapping as in geneList
## defined above.
mergedHumanData <-merge(geneList,humanSplit[[y]], by.x = "human", by.y = "humanGene")
mergedRatData <- merge(geneList, ratSplit[[x]], by.x = "rat", by.y = "ratGene")
## [here i do other manipulation with using already defined function
## getGenetype that is defined outside of this function and make things
## necessary to define following contingency table]
contingencyTable <- matrix(c(HnRn,HnRy,HyRn,HyRy), nrow = 2)
fisherTest <- fisher.test(contingencyTable)
humanReplicate <- c(humanReplicate,humanReplicateName )
ratReplicate <- c(ratReplicate,ratReplicateName )
pvalue <- c(pvalue , fisherTest$p)
}
After doing all this I do the make matrix eg to use in apply. Here I am basically trying to do something similar to double for loop and then using fisher
eg <- expand.grid(i = 1:length(ratSplit),j = 1:length(humanSplit))
junk = apply(eg, 1, fishertest(eg$i,eg$j))
Now the problem is, when I try to run, it gives the following error when it tries to use function fishertest in apply
Error in humanSplit[[y]] : recursive indexing failed at level 3
Rstudio points out problem in following line:
mergedHumanData <-merge(geneList,humanSplit[[y]], by.x = "human", by.y = "humanGene")
Ultimately, I want to do the following:
result <- data.frame(humanReplicate,ratReplicate, pvalue ,alternative, Conf.int1, Conf.int2, oddratio)
I am struggling with these questions:
In defining fishertest function, how should I pass ratSplit and humanSplit and already defined function getGenetype?
And how I should use apply here?
Any help would be much appreciated.
Up front: read ?apply. Additionally, the first three hits on google when searching for "R apply tutorial" are helpful snippets: one, two, and three.
Errors in fishertest()
The error message itself has nothing to do with apply. The reason it got as far as it did is because the arguments you provided actually resolved. Try to do eg$i by itself, and you'll see that it is returning a vector: the corresponding column in the eg data.frame. You are passing this vector as an index in the i argument. The primary reason your function erred out is because double-bracket indexing ([[) only works with singles, not vectors of length greater than 1. This is a great example of where production/deployed functions would need type-checking to ensure that each argument is a numeric of length 1; often not required for quick code but would have caught this mistake. Had it not been for the [[ limit, your function may have returned incorrect results. (I've been bitten by that many times!)
BTW: your code is also incorrect in its scoped access to pvalue, et al. If you make your function return just the numbers you need and the aggregate it outside of the function, your life will simplify. (pvalue <- c(pvalue, ...) will find pvalue assigned outside the function but will not update it as you want. You are defeating one purpose of writing this into a function. When thinking about writing this function, try to answer only this question: "how do I compare a single rat record with a single human record?" Only after that works correctly and simply without having to overwrite variables in the parent environment should you try to answer the question "how do I apply this function to all pairs and aggregate it?" Try very hard to have your function not change anything outside of its own environment.
Errors in apply()
Had your function worked properly despite these errors, you would have received the following error from apply:
apply(eg, 1, fishertest(eg$i, eg$j))
## Error in match.fun(FUN) :
## 'fishertest(eg$i, eg$j)' is not a function, character or symbol
When you call apply in this sense, it it parsing the third argument and, in this example, evaluates it. Since it is simply a call to fishertest(eg$i, eg$j) which is intended to return a data.frame row (inferred from your previous question), it resolves to such, and apply then sees something akin to:
apply(eg, 1, data.frame(...))
Now that you see that apply is being handed a data.frame and not a function.
The third argument (FUN) needs to be a function itself that takes as its first argument a vector containing the elements of the row (1) or column (2) of the matrix/data.frame. As an example, consider the following contrived example:
eg <- data.frame(aa = 1:5, bb = 11:15)
apply(eg, 1, mean)
## [1] 6 7 8 9 10
# similar to your use, will not work; this error comes from mean not getting
# any arguments, your error above is because
apply(eg, 1, mean())
## Error in mean.default() : argument "x" is missing, with no default
Realize that mean is a function itself, not the return value from a function (there is more to it, but this definition works). Because we're iterating over the rows of eg (because of the 1), the first iteration takes the first row and calls mean(c(1, 11)), which returns 6. The equivalent of your code here is mean()(c(1, 11)) will fail for a couple of reasons: (1) because mean requires an argument and is not getting, and (2) regardless, it does not return a function itself (in a "functional programming" paradigm, easy in R but uncommon for most programmers).
In the example here, mean will accept a single argument which is typically a vector of numerics. In your case, your function fishertest requires two arguments (templated by my previous answer to your question), which does not work. You have two options here:
Change your fishertest function to accept a single vector as an argument and parse the index numbers from it. Bothing of the following options do this:
fishertest <- function(v) {
x <- v[1]
y <- v[2]
ratReplicateName <- names(ratSplit[x])
## ...
}
or
fishertest <- function(x, y) {
if (missing(y)) {
y <- x[2]
x <- x[1]
}
ratReplicateName <- names(ratSplit[x])
## ...
}
The second version allows you to continue using the manual form of fishertest(1, 57) while also allowing you to do apply(eg, 1, fishertest) verbatim. Very readable, IMHO. (Better error checking and reporting can be used here, I'm just providing a MWE.)
Write an anonymous function to take the vector and split it up appropriately. This anonymous function could look something like function(ii) fishertest(ii[1], ii[2]). This is typically how it is done for functions that either do not transform as easily as in #1 above, or for functions you cannot or do not want to modify. You can either assign this intermediary function to a variable (which makes it no longer anonymous, figure that) and pass that intermediary to apply, or just pass it directly to apply, ala:
.func <- function(ii) fishertest(ii[1], ii[2])
apply(eg, 1, .func)
## equivalently
apply(eg, 1, function(ii) fishertest(ii[1], ii[2]))
There are two reasons why many people opt to name the function: (1) if the function is used multiple times, better to define once and reuse; (2) it makes the apply line easier to read than if it contained a complex multi-line function definition.
As a side note, there are some gotchas with using apply and family that, if you don't understand, will be confusing. Not the least of which is that when your function returns vectors, the matrix returned from apply will need to be transposed (with t()), after which you'll still need to rbind or otherwise aggregrate.
This is one area where using ddply may provide a more readable solution. There are several tutorials showing it off. For a quick intro, read this; for a more in depth discussion on the bigger picture in which ddply plays a part, read Hadley's Split, Apply, Combine Strategy for Data Analysis paper from JSS.

what data type is produced by mapply()?

This is what my code looks like. a, b, c, and d are scalers, e is a list of vectors. A, B, C and D are vectors.
GetOutput=function(a,b,c,d){
e=FunOther(a,b,c,d)
i=mean(e$f)
j=mean(e$g)
k=abs(mean(e$h))
return(list(b=b,i=i,j=j,k=k))
}
Output=mapply(GetOutput,A,B,C,D)
GetOutput will return a list of 4 scalers. I want to factor this up to a matrix of inputs and a matrix of outputs. I had been using a for loop but I thought I would try mapply instead.
Suppose A, B, C and D have a length 100. I just want to get a vector with length 100 which give me all of the i's so that I can calculate their minima. Then the same for the j's and k's. This is part of a Monte Carlo study. But I am having trouble understanding the Output object. It appears to be a list of lists. What I thought would be a one liner turns into several operations. The best I can come up with is:
Output2=as.data.frame(t(Output))
OutputMeans=c(mean(as.numeric(Output2$i)),
mean(as.numeric(Output2$j)),
mean(as.numeric(Output2$k)))
This seems just bananas to me. I though I could operate on Output directly with the mean function without having to bother with all of these transformations.
If you had instead written: return( c(b=b,i=i,j=j,k=k) ) , then each element in the list from mapply would have been a named vector, rather than what you did get .... a list of lists. And since the 'simplify' argument would have let you return a matrix, you could have returned a non-recursive result as well. Because mapply is so versatile, it gives you multiple levels of control of the returned structure.
Another R programming tip: Don't use '$' as an extraction function inside functions. If you are sure of your column name you can use `[['colname']] but then by using '[[' you can later generalize your function to accept column names as arguments, a feature which '$' will not support.

R curve() on expression involving vector

I'd like to plot a function of x, where x is applied to a vector. Anyway, easiest to give a trivial example:
var <- c(1,2,3)
curve(mean(var)+x)
curve(mean(var+x))
While the first one works, the second one gives errors:
'expr' did not evaluate to an object of length 'n' and
In var + x : longer object length is not a multiple of shorter object length
Basically I want to find the minimum of such a function: e.g.
optimize(function(x) mean(var+x), interval=c(0,1))
And then be able to visualise the result. While the optimize function works, I can't figure out how to get the curve() to work as well.. Thanks!
The function needs to be vectorized. That means, if it evaluates a vector it has to return a vector of the same length. If you pass any vector to mean the result is always a vector of length 1. Thus, mean is not vectorized. You can use Vectorize:
f <- Vectorize(function(x) mean(var+x))
curve(f,from=0, to=10)
This can be done in the general case using sapply:
curve(sapply(x, function(e) mean(var + e)))
In the specific example you give, mean(var) + x, is of course arithmetically equivalent to what you're looking for. Similar shortcuts might exist for whatever more complicated function you're working with.

Resources