I'd like to replicate an NxM matrix into an NxMx3 matrix, i.e. have 3 copies of the input matrix in the third dimension. How do I do that?
If A is your NxM matrix, then the NxMx3 matrix is:
B = hypermat([size(A), 3], kron(ones(3, 1), A(1:$)))
or
B = hypermat([size(A), 3], ones(3, 1).*.A(1:$))
Here is a better and simpler answer (without using any operator):
B = A(:,:,[1 1 1])
Example (two copies are enough here):
-> a=[1 2;3 4]
a =
1. 2.
3. 4.
--> a(:,:,[1 1])
ans =
(:,:,1)
1. 2.
3. 4.
(:,:,2)
1. 2.
3. 4.
Related
When comparing two vectors it is simple to calculate the angle between them, but in R it is noticeably harder to calculate the angle between a vector and a matrix of vectors efficiently.
Say you have a 2D vector A=(2, 0) and then a matrix B={(1,3), (-2,4), (-3,-3), (1,-4)}. I am interested in working out the smallest angle between A and the vectors in B.
If I try to use
min(acos( sum(a%*%b) / ( sqrt(sum(a %*% a)) * sqrt(sum(b %*% b)) ) ))
it fails as they are non-conformable arguments.
Is there any code similar to that of above which can handle a vector and matrix?
Note: At the risk of being marked as a duplicate the solutions found in several sources do not apply in this case
Edit: The reason for this is I have a large matrix X, and A is just one row of this. I am reducing the number of elements based solely on the angle of each vector. The first element of B is the first in X, and then if the angle between any element in B and the next element X[,2] (here A) is greater than a certain tolerance, this is added to the list B. I am just using B<-rbind(B,X[,2]) to do this, so this results in B being a matrix.
You don't describe the format of A and B in detail, so I assume they are matrices by rows.
(A <- c(2, 0))
# [1] 2 0
(B <- rbind(c(1,3), c(-2,4), c(-3,-3), c(1,-4)))
# [,1] [,2]
# [1,] 1 3
# [2,] -2 4
# [3,] -3 -3
# [4,] 1 -4
Solution 1 with apply():
apply(B, 1, FUN = function(x){
acos(sum(x*A) / (sqrt(sum(x*x)) * sqrt(sum(A*A))))
})
# [1] 1.249046 2.034444 2.356194 1.325818
Solution 2 with sweep(): (replace sum() above with rowSums())
sweep(B, 2, A, FUN = function(x, y){
acos(rowSums(x*y) / (sqrt(rowSums(x*x)) * sqrt(rowSums(y*y))))
})
# [1] 1.249046 2.034444 2.356194 1.325818
Solution 3 with split() and mapply:
mapply(function(x, y){
acos(sum(x*y) / (sqrt(sum(x*x)) * sqrt(sum(y*y))))
}, split(B, row(B)), list(A))
# 1 2 3 4
# 1.249046 2.034444 2.356194 1.325818
The vector of dot products between the rows of B and the vector A is B %*% A. The vector lengths of the rows of B are sqrt(rowSums(B^2)).
To find the smallest angle, you want the largest cosine, but you don't actually need to compute the angle, so the length of A doesn't matter.
Thus the row with the smallest angle will be given by row <- which.max((B %*% A)/sqrt(rowSums(B^2))). With Darren's data, that's row 1.
If you really do need the smallest angle, then you can apply the formula for two vectors to B[row,] and A. If you need all of the angles, then the formula would be
acos((B %*% A)/sqrt(rowSums(B^2))/sqrt(sum(A^2)))
I am trying to simulate an unlikely situation in a videogame using a Monte Carlo simulation. I'm extremely new at coding and thought this would be a fun situation to simulate.
There are 3 targets and they are being attacked 8 times independently. My problem comes with how to deal with the fact that one of the columns cannot be attacked more than 6 times, when there are 8 attacks.
I would like to take any attack aimed at column 2 select one of the other 2 columns at random to attack instead, but only if column 2 has been attacked 6 times already.
Here is my attempt to simulate with 5000 repeats, for example.
#determine number of repeats
trial <- 5000
#create matrix with a row for each trial
m <- matrix(0, nrow = trial, ncol = 3)
#The first for loop is for each row
#The second for loop runs each attack independently, sampling 1:3 at random, then adding one to that position of the row.
#The function that is called by ifelse() when m[trial, 2] > 6 = TRUE is the issue.
for (trial in 1:trial){
for (attack in 1:8) {
target <- sample(1:3, 1)
m[trial, target] <- m[trial, target] + 1
ifelse(m[trial, 2] > 6, #determines if the value of column 2 is greater than 6 after each attack
function(m){
m[trial, 2] <- m[trial, 2] - 1 #subtract the value from the second column to return it to 6
newtarget <- sample(c(1,3), 1) #select either column 1 or 3 as a new target at random
m[trial, newtarget] <- m[trial, newtarget] + 1 #add 1 to indicate the new target has been selected
m}, #return the matrix after modification
m) #do nothing if the value of the second column is <= 6
}
}
For example, if I have the matrix below:
> matrix(c(2,1,5,7,1,0), nrow = 2, ncol = 3)
[,1] [,2] [,3]
[1,] 2 5 1
[2,] 1 7 0
I would like the function to look at the 2nd line of the matrix, subtract 1 from 7, and then add 1 to either column 1 or 3 to create c(2,6,0) or c(1,6,1). I would like to learn how to do this within the loop, but it could be done afterwards as well.
I think I am making serious, fundamental error with how to use function(x) or ifelse.
Thank you.
Here's an improved version of your code:
set.seed(1)
trial <- 5000
#create matrix with a row for each trial
m <- matrix(0, nrow = trial, ncol = 3)
#The first for loop is for each row
#The second for loop runs each attack independently, sampling 1:3 at random, then adding one to that position of the row.
#The function that is called by ifelse() when m[trial, 2] > 6 = TRUE is the issue.
for (i in 1:trial){
for (attack in 1:8) {
target <- sample(1:3, 1)
m[i, target] <- m[i, target] + 1
#determines if the value of column 2 is greater than 6 after each attack
if(m[i, 2] > 6){
#subtract the value from the second column to return it to 6
m[i, 2] <- m[i, 2] - 1
#select either column 1 or 3 as a new target at random
newtarget <- sample(c(1,3), 1)
#add 1 to indicate the new target has been selected
m[i, newtarget] <- m[i, newtarget] + 1
}
}
}
# Notice the largest value in column 2 is no greater than 6.
apply(m, 2, max)
set.seed is used to make the results reproducible (usually just used for testing). The ifelse function has a different purpose than the normal if-else control flow. Here's an example:
x = runif(100)
ifelse(x < 0.5, 0, x)
You'll notice any element in x that is less than 0.5 is now zero. I changed your code to have an if block. Notice that m[i, 2] > 6 returns a single TRUE or FALSE whereas in the small example above, x < 0.5 a vector of logicals is returned. So ifelse can take a vector of logicals, but the if block requires there be only a single logical.
You were on the right track with using function, but it just isn't necessary in this case. Often, but not always, you'll define a function like this:
f = function(x)
x^2
But just returning the value doesn't mean what you want is changed:
x = 5
f(5) # 25
x # still 5
For more on this, look up function scope in R.
Lastly, I changed the loop to be i in 1:trial instead of trial in 1:trial. You probably wouldn't notice any issues in your case, but it is better practice to use a separate variable than that which makes up the range of the loop.
Hope this helps.
P.S. R isn't really known for it's speed when looping. If you want to make things goes faster, you'll typically need to vectorize your code.
I am looking for a general purpose algorithm to identify short numeric series from lists with a max length of a few hundred numbers. This will be used to identify series of masses from mass spectrometry (ms1) data.
For instance, given the following list, I would like to identify that 3 of these numbers fit the series N + 1, N +2, etc.
426.24 <= N
427.24 <= N + 1/x
371.10
428.24 <= N + 2/x
851.47
451.16
The series are all of the format: N, N+1/x, N+2/x, N+3/x, N+4/x, etc, where x is an integer (in the example x=1). I think this constraint makes the problem very tractable. Any suggestions for a quick/efficient way to tackle this in R?
This routine will generate series using x from 1 to 10 (you could increase it). And will check how many are contained in the original list of numbers.
N = c(426.24,427.24,371.1,428.24,851.24,451.16)
N0 = N[1]
x = list(1,2,3,4,5,6,7,8,9,10)
L = 20
Series = lapply(x, function(x){seq(from = N0, by = 1/x,length.out = L)})
countCoincidences = lapply(Series, function(x){sum(x %in% N)})
Result:
unlist(countCoincidences)
[1] 3 3 3 3 3 3 3 3 3 2
As you can see, using x = 1 will have 3 coincidences. The same goes for all x until x=9. Here you have to decide which x is the one you want.
Since you're looking for an arithmetic sequence, the difference k is constant. Thus, you can loop over the vector and subtract each value from the sequence. If you have a sequence, subtracting the second term from the vector will result in values of -k, 0, and k, so you can find the sequence by looking for matches between vector - value and its opposite, value - vector:
x <- c(426.24, 427.24, 371.1, 428.24, 851.47, 451.16)
unique(lapply(x, function(y){
s <- (x - y) %in% (y - x);
if(sum(s) > 1){x[s]}
}))
# [[1]]
# NULL
#
# [[2]]
# [1] 426.24 427.24 428.24
I have an ex. where I have to see how many values of a vector are divisible by 2. I have this random sample:
set.seed(1)
y <- sample(c(0:99, NA), 400, replace=TRUE)
I created a new variable d to see which of the values are or aren't divisible by 2:
d <- y/2 ; d
What I want to do is to create a logical argument, where all entire numbers give true and the rest gives false. (ex: 22.0 -> TRUE & 24.5 -> FALSE)
I used this command, but I believe that the answer is wrong since it would only give me the numbers that are in the sample:
sum(d %in% y, na.rm=T)
I also tried this (I found on the internet, but I don't really understand it)
is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol
sum(is.wholenumber(d),na.rm = T)
Are there other ways that I could use the operator "%%"?
you can sum over the mod operator like so: sum(1-y%%2) or sum(y%%2 == 0). Note that x %% 2 is the remainder after dividing by two which is why this solution works.
Here are three different ways:
length(y[y %% 2 == 0])
length(subset(y, y %% 2 == 0))
length(Filter(function(x) x %% 2 == 0, y))
Since we're talking about a division by 2, I would actually take it to the bit level and check if the last bit of the number is a 0 or a 1 (a 0 means it would be divisible by 2).
Going out on a limb here (not sure how the compiler handles this division by 2) but think that would likely be more optimized than a division, which is typically fairly expensive.
To do this at the bit level, you can just do an AND operation between the number itself and 1, if result it 1 it means won't be divisible by 2:
bitwAnd(a, b)
Let's say I want to multiply each even element of a vector by 2 and each odd element of a vector by 3. Here is some code that can do this:
v <- 0:10
idx <- v %% 2 == 0
v[idx] <- v[idx] * 2
v[!idx] <- v[!idx] * 3
This would get difficult if I had more than two cases. It seems like the apply family of functions never deals with vectors so I don't know a better way to do this problem. Maybe using an apply function would work if I made transformations on the data, but it seems like that shouldn't be something that I would need to do to solve this simple problem.
Any ideas?
Edit: Sorry for the confusion. I am not specifically interested in the "%%" operator. I wanted to put some concrete code in my question, but, based on the responses to the question, was too specific. I wanted to figure out how to apply some arbitrary function to each member of the list. This was not possible with apply() and I thought sapply() only worked with lists.
You can do:
v <- v * c(2, 3)[v %% 2 + 1]
It is generalizable to any v %% n, e.g.:
v <- v * c(2, 3, 9, 1)[v %% 4 + 1]
Also it does not require that length(v) be a multiple of n.
You can use vector multiplication to do what you want:
tmp <- 1:10
tmp * rep(c(3,2), length(tmp)/2)
This is easy to extend to three or more cases:
tmp * rep(c(3,2,4), length(tmp)/3)
Easiest would be:
v*c(2,3) # as suggested by flodel in a comment.
The term to search for in the documentation is "argument recycling" ... a feature of the R language. Only works for dyadic infix functions (see ?Ops). For non-dyadcic vectorized functions that would not error out with some of the arguments and where you couldn't depend on the structure of "v" to be quite so regular, you could use ifelse:
ifelse( (1:length(v)) %% 2 == 0, func1(v), func2(v) )
This constructs two vectors and then chooses elements in the first or second based on the truth value of hte first argument. If you were trying to answer the question in the title of your posting then you should look at:
?sapply
Here is an answer allowing any set of arbitrary functions to be applied to defined groups within a vector.
# source data
test <- 1:9
# categorisations of source data
cattest <- rep(1:3,each=3)
#[1] 1 1 1 2 2 2 3 3 3
Make the function to differentially apply functions:
categ <- function(x,catg) {
mapply(
function(a,b) {
switch(b,
a * 2,
a * 3,
a / 2
)
},
x,
catg
)
}
# where cattest = 1, multiply by 2
# where cattest = 2, multiply by 3
# where cattest = 3, divide by 2
The result:
categ(test,cattest)
#[1] 2.0 4.0 6.0 12.0 15.0 18.0 3.5 4.0 4.5