How to perform complex looping operation on matrix - r

I have a sample matrix like
5 4 3
2 6 8
1 9 7
and I want output like
max(5*6,5*8,5*9,5*7) // i!=j condition
max(4*2,4*8,4*1,4*7)
max(3*2,3*6,3*1,3*9)
And so on...
This maximum values obtained after computation should be in matrix form. I need to generalize it, therefore I need a generic code.

This gets the job done but is a pretty unimaginative solution, in that it just loops through the rows and columns performing the requested calculation instead of doing anything vectorized.
sapply(1:ncol(m), function(j) sapply(1:nrow(m), function(i) max(m[i,j]*m[-i,-j])))
# [,1] [,2] [,3]
# [1,] 45 32 27
# [2,] 18 42 72
# [3,] 8 72 42
Data:
(m <- matrix(c(5, 2, 1, 4, 6, 9, 3, 8, 7), nrow=3))
# [,1] [,2] [,3]
# [1,] 5 4 3
# [2,] 2 6 8
# [3,] 1 9 7

Related

R: How can I obtain returns by row in a matrix?

First I create a 5x4 matrix with random numbers from 1 to 10:
A <- matrix(sample(1:10, 20, TRUE), 5, 4)
> A
[,1] [,2] [,3] [,4]
[1,] 1 5 6 6
[2,] 5 9 9 4
[3,] 10 6 1 8
[4,] 4 4 10 2
[5,] 10 9 7 5
In the following step I would like to obtain the returns by row (for row 1: (5-1)/1, (6-5)/5, (6-6)/6 and the same procedure for the other rows). The final matrix should therefore be a 5x3 matrix.
You can make use of the Base R funtion diff() applied to your transposed matrix:
Code:
# Data
set.seed(1)
A <- matrix(sample(1:10, 20, TRUE), 5, 4)
# [,1] [,2] [,3] [,4]
#[1,] 9 7 5 9
#[2,] 4 2 10 5
#[3,] 7 3 6 5
#[4,] 1 1 10 9
#[5,] 2 5 7 9
# transpose so we get per row and not column returns
t(diff(t(A))) / A[, -ncol(A)]
[,1] [,2] [,3]
[1,] -0.2222222 -0.2857143 0.8000000
[2,] -0.5000000 4.0000000 -0.5000000
[3,] -0.5714286 1.0000000 -0.1666667
[4,] 0.0000000 9.0000000 -0.1000000
[5,] 1.5000000 0.4000000 0.2857143
A <- matrix(sample(1:10, 20, TRUE), 5, 4)
fn.Calc <- function(a,b){(a-b)/a}
B <- matrix(NA, nrow(A), ncol(A)-1)
for (ir in 1:nrow(B)){
for (ic in 1:ncol(B)){
B[ir, ic] <- fn.Calc(A[ir, ic+1], A[ir, ic])
}
}
small note: when working with random functions providing a seed is welcomed ;)
So what we have here:
fn.Calc is just the calculation you are trying to do, i've isolated it in a function so that it's easier to change if needed
then a new B matrix is created having 1 column less then A but the same rows
finally we are going to loop every element in this B matrix, I like to use ir standing for incremental rows and ic standing for incremental column and finally inside the loop (B[ir, ic] <- fn.Calc(A[ir, ic+1], A[ir, ic])) is when the magic happens where the actual values are calculated and stored in B
it's a very basic approach without calling any package, there's probably many other ways to solve this that require less code.

Draw d observation from a sample n times and calculate the mean

Consider the following data:
x <- c(2, 4, 6, 8)
mean(x)
[1] 5
Now I want do draw 2 observations. This gives me 6 combinations. I want to calculate the mean for all 6 combinations, and the mean of these 6 values. That is, I should get the following means:
(2+4)/2 = 3
(2+6)/2 = 4
(2+8)/2 = 5
(4+6)/2 = 5
(4+8)/2 = 6
(6+8)/2 = 7
I know the order could be different from the above, but it should each time give me an average 5 (in the case above: (3+4+5+5+6+7)/6 = 5).
Can anyone help me?
One Line answer:
mean(rowMeans(t(combn(x,2))))
explained step by step:
with 'draw 2 observations' you actually mean to select 2 objects/observations out of x:
x <- c(2, 4, 6, 8)
combn(x, 2)
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 2 2 2 4 4 6
## [2,] 4 6 8 6 8 8
with t() you can transform it to:
t(combn(x,2))
## [,1] [,2]
## [1,] 2 4
## [2,] 2 6
## [3,] 2 8
## [4,] 4 6
## [5,] 4 8
## [6,] 6 8
The means you can calculate by rowMeans()
rowMeans(t(combn(x,2)))
## [1] 3 4 5 5 6 7
If you calculate the mean of that, you get what you want.
mean(rowMeans(t(combn(x,2))))
## [1] 5
I think OP was going in right-direction to use sample in order to draw 2 observations n times (as title suggests). But somehow angle of solution changed towards combn function (which is not a correct option).
An option is to use sample along with replicate as:
x <- c(2, 4, 6, 8)
mean(replicate(6, sample(x,2)))
#[1] 4.666667 #There is random-ness in set of observations selected.
In above attempt, replicate provides 6 sets of 2 observations as:
replicate(6, sample(x,2))
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 2 4 4 4 8 8
# [2,] 6 2 2 8 6 2
Personally, I dont think combn is a correct option to use here. combn returns all possible combination of selected number of observations. That means, every observation (of x) will appear equal number of times in combination set received from combn function. This implies, that mean of combn(x,2) will be same as mean(x). Hence, what's point using combn in this case.

Issue in using Replace function for Matrix in R

I just tried to replace the [2,3]th element of a matrix with 100, but it replaces [3,2]th element:
and when I tried to change the [3,2]th element it changes the [1,1]th element:
How can I solve this?
We are replacing the index 7 with 100 as
A[2, 3]
#[1] 7
Instead we can use the row/column indexing
replace(A, cbind(2,3), 100)
# [,1] [,2] [,3] [,4]
#[1,] 1 2 3 4
#[2,] 5 6 100 8
#[3,] 9 10 11 12
#[4,] 13 14 15 16
data
A <- matrix(1:16, 4, 4, byrow=TRUE)

apply function to subsets of each row in R

I am struggling to find a way to apply a specific function using apply, only to a "chunk" of a specific row.
For instance, I have a matrix:
x <- matrix(c(5,12,4,3,2,8,10,7,9,1,11,6),nrow=3)
[,1] [,2] [,3] [,4]
[1,] 5 3 10 1
[2,] 12 2 7 11
[3,] 4 8 9 6
And I would like to end up with a new matrix, made up of a sum of the first and last two values in each row. Like so:
[,1] [,2]
[1,] 8 11
[2,] 14 18
[3,] 12 15
I have tried something like this:
chunks<-c("1:2","3:4")
sumchunks<-function(x,chunks){
apply(x,1,
function(row){
for (i in chunks){
v<-sum(row[chunks[i]])
}})
}
But it doesn't work at all. Any suggestion on successful ways?
Thank you.
You can do:
chunks <- list(1:2, 3:4)
sumchunks <- function(x, chunks) sapply(chunks, function(ch) sum(x[ch]))
x <- matrix(c(5,12,4,3,2,8,10,7,9,1,11,6),nrow=3)
apply(x, 1, sumchunks, chunks=chunks)
# [,1] [,2] [,3]
# [1,] 8 14 12
# [2,] 11 18 15
Eventually you want to transpose the result.
Here is a vectorized variant:
chunks <- list(1:2, 3:4)
x <- matrix(c(5,12,4,3,2,8,10,7,9,1,11,6),nrow=3)
sapply(chunks, function(ch) rowSums(x[,ch]))
# [,1] [,2]
# [1,] 8 11
# [2,] 14 18
# [3,] 12 15
We can convert to array and then do
t(apply(array(x, c(3, 2, 2)), 1, colSums))
Or
sapply(seq(1, ncol(x), 2), function(i) rowSums(x[,i:(i+1)]))
# [,1] [,2]
#[1,] 8 11
#[2,] 14 18
#[3,] 12 15
like this?
x <- matrix(sample(1:12),nrow=3)
f = function(s) {
c(sum(s[1:2]), sum(s[3:4]))
}
t(apply(x, 1, f))
rowSums was built to sum over rows so should be quite fast. You can limit the columns you want to sum over and then cbind them to get what you want:
cbind(rowSums(x[,c(1,2)]), rowSums(x[,c(3,4)]))
# [,1] [,2]
#[1,] 8 11
#[2,] 14 18
#[3,] 12 15

R genealg package rbga.bin evaluation function

I am trying to solve the TSP (Traveling Salesman Problem) using the rbga.bin from the genealg package. I have matrix that stores the distances between the cities
like this:
[,1] [,2] [,3] [,4]
[1,] 0 2 10 4
[2,] 0 0 12 12
[3,] 0 0 0 5
[4,] 0 0 0 0
but I'm not able to code a proper evaluation function (even though I already saw some examples in documentation and on the web). I know a chromosome will be passed as a parameter to the evaluation function, but I don't know what operations to do to return a proper value.
Basically, you are asking how to evaluate the length of a path given the endpoints on that path and a distance matrix (for path 1-3-2-4, you want d13+d32+d24+d41). You can do this with matrix indexing and the sum function. Let's consider your distance matrix and solution 1-3-2-4 (since the TSP is typically posed in a symmetric form, I've made it symmetric):
(d <- matrix(c(0, 2, 10, 4, 2, 0, 12, 12, 10, 12, 0, 5, 4, 12, 5, 0), nrow=4))
# [,1] [,2] [,3] [,4]
# [1,] 0 2 10 4
# [2,] 2 0 12 12
# [3,] 10 12 0 5
# [4,] 4 12 5 0
sln <- c(1, 3, 2, 4)
Now you can grab matrix indexes from your solution and pull the distances, summing them for your final evaluation:
(idx <- cbind(sln, c(tail(sln, -1), sln[1])))
# [1,] 1 3
# [2,] 3 2
# [3,] 2 4
# [4,] 4 1
d[idx]
# [1] 10 12 12 4
sum(d[idx])
# [1] 38

Resources