randomized element-wise multiplication in R - r

I've been digging around the site for an answer to my question, and I'm new with R so I'm hoping this is even possible. I have two large matrices of simulations (A = 100,000 x 50 and B = 10,000 x 50) that I would like to randomly multiply element-wise by row.
Essentially I would like each row in A to randomly select a row from B for element-wise multiplication.
A:
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 1 1
[2,] 1 1 1 1 1
[3,] 1 1 1 1 1
[4,] 1 1 1 1 1
[5,] 1 1 1 1 1
[6,] 1 1 1 1 1
[7,] 1 1 1 1 1
[8,] 1 1 1 1 1
[9,] 1 1 1 1 1
[10,] 1 1 1 1 1
And
B:
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 1 1
[2,] 2 2 2 2 2
[3,] 3 3 3 3 3
[4,] 4 4 4 4 4
[5,] 5 5 5 5 5
Is there an operator that could go through A's rows and randomly select a row from B to pair for element wise multiplication? For results something like this:
C <- A&*&B
C
A[1,]*B[3,]
A[2,]*B[1,]
A[3,]*B[2,]
A[4,]*B[5,]
A[5,]*B[3,]
A[6,]*B[4,]
A[7,]*B[1,]
A[8,]*B[5,]
A[9,]*B[2,]
A[10,]*B[2,]
Thanks!

Try this:
row_id <- sample(1:nrow(B), nrow(A), replace = TRUE)
A * B[row_id, ]
I think I only need to explain what sample() does. Consider:
sample(1:5, 10, replace = TRUE)
[1] 4 5 2 4 1 2 2 1 2 5
I did not set random seed by set.seed(), so when you run it, you will get different result. But all you need to know is that: it is random.

Related

How to assign the same vector in every row of a matrix

I want to put the same vector in each row of an empty matrix in R. I thought that the following would work but it doesn't. It assigns 1 to the first entry (1,1) then 0 to (2,1) then zero again to (1,2) and 1 to (2,2) etc.
P = matrix(0,100,3)
P[1:2,]=c(1,0,0)
Any ideas, how to do that?? I want to avoid loops if it is possible.
You could use replicate to copy directly, without needing to start with an empty matrix
vec <- 1:5
t(replicate(10, vec))
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 1 2 3 4 5
#> [2,] 1 2 3 4 5
#> [3,] 1 2 3 4 5
#> [4,] 1 2 3 4 5
#> [5,] 1 2 3 4 5
#> [6,] 1 2 3 4 5
#> [7,] 1 2 3 4 5
#> [8,] 1 2 3 4 5
#> [9,] 1 2 3 4 5
#> [10,] 1 2 3 4 5
We can replicate it by the number of rows it is going to be changed
n <- 2
P[seq_len(n),] <- rep(c(1,0,0), each = n)
Or it can be constructed with matrix call itself
vec <- c(1, 0, 0)
matrix(vec, 100, length(vec), byrow = TRUE)
Or another option is to wrap list and replicate
do.call(rbind, rep(list(vec), 100))
Another base R option is using kronecker
v <- c(1, 0, 0)
t(kronecker(t(rep(1, 10)), v))
which gives
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 1 0 0
[3,] 1 0 0
[4,] 1 0 0
[5,] 1 0 0
[6,] 1 0 0
[7,] 1 0 0
[8,] 1 0 0
[9,] 1 0 0
[10,] 1 0 0
Note that R recycles data as long as the integer dimensional integrity is maintained.
n <- 1:5
m <- matrix(n, nrow = 100, ncol = 5, byrow = TRUE)

Get index locations of 0s which are completely surrounded by 1s

I have a matrix like so:
m <- matrix(c(1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,2,0,1,1,1,1,1,1,1,1,1), nrow = 12, ncol = 12)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[1,] 1 1 1 1 1 1 1 1 1 1 1 1
[2,] 1 1 2 1 1 2 1 1 2 1 1 2
[3,] 1 1 0 1 1 0 1 1 0 1 1 0
[4,] 1 1 1 1 1 1 1 1 1 1 1 1
[5,] 1 1 1 1 1 1 1 1 1 1 1 1
[6,] 1 1 1 1 1 1 1 1 1 1 1 1
[7,] 1 1 1 1 1 1 1 1 1 1 1 1
[8,] 1 1 1 1 1 1 1 1 1 1 1 1
[9,] 0 1 1 0 1 1 0 1 1 0 1 1
[10,] 1 1 1 1 1 1 1 1 1 1 1 1
[11,] 1 1 1 1 1 1 1 1 1 1 1 1
[12,] 1 1 1 1 1 1 1 1 1 1 1 1
and I want to find the index locations where 0 is completely surrounded by 1s in a 3x3 window. I can find all the zeros with:
which(m == 0) but this will also return places where a 2 surrounds a 0 such as at index location m[3,3]
w <- which(m == 0, arr.ind = TRUE)
w
# row col
# [1,] 9 1
# [2,] 3 3
# [3,] 9 4
# [4,] 3 6
# [5,] 9 7
# [6,] 3 9
# [7,] 9 10
# [8,] 3 12
We don't need to know which zeroes are on a boundary, so filter out those:
w <- w[ w[,1] > 1 & w[,1] < (nrow(m)-1) & w[,2] > 2 & w[,2] < (ncol(m)-1), ]
w
# row col
# [1,] 3 3
# [2,] 9 4
# [3,] 3 6
# [4,] 9 7
# [5,] 3 9
# [6,] 9 10
Now we can take those inner indices and build 3x3 submatrices into a list. Here are the first couple (of six):
Map(function(rn,cn) m[rn+(-1:1),cn+(-1:1)], w[,1], w[,2])[1:2]
# [[1]]
# [,1] [,2] [,3]
# [1,] 1 2 1
# [2,] 1 0 1
# [3,] 1 1 1
# [[2]]
# [,1] [,2] [,3]
# [1,] 1 1 1
# [2,] 1 0 1
# [3,] 1 1 1
Now we can just filter out the ones where there is only one non-1 entry in the matrix.
Filter(function(m3) sum(m3 != 1) == 1, Map(function(rn,cn) m[rn+(-1:1),cn+(-1:1)], w[,1], w[,2]))
# [[1]]
# [,1] [,2] [,3]
# [1,] 1 1 1
# [2,] 1 0 1
# [3,] 1 1 1
# [[2]]
# [,1] [,2] [,3]
# [1,] 1 1 1
# [2,] 1 0 1
# [3,] 1 1 1
# [[3]]
# [,1] [,2] [,3]
# [1,] 1 1 1
# [2,] 1 0 1
# [3,] 1 1 1
Since you need to just count the occurrences, add length(...) around that, and you have your answer.
(If you're curious, the reason I went with sum(m3!=1)==1 is because I wasn't certain if you wanted the border submatrices as well. If you wanted those, then the number of 1s would be reduced, not "8" as a typical 3x3 would be. But we know that there should always be exactly one non-1 in the submatrix: the center 0.)
To get just the indices that match,
w[mapply(function(rn,cn) sum(m[rn+(-1:1),cn+(-1:1)] != 1) == 1,
w[,1], w[,2]),]
# row col
# [1,] 9 4
# [2,] 9 7
# [3,] 9 10

Insert column vector at specific position in matrix dynamically

i have to put a new vector (in this example zero-vector) into an exisiting matrix. The problem is that I have an iterative process and the positions and number of vectors to insert change. I have not been able to come up with a function that a) works and b) is efficient enough for huge amounts of data.
A non-dynamic approach using simply cbind() is
old <- matrix(1,10,10) #original matrix
vec <- matrix(5,10,1) #vector 1 to insert
vec2 <- matrix(8,10,1) #vector 2 to insert
old
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 1 1 1 1 1 1 1 1 1
[2,] 1 1 1 1 1 1 1 1 1 1
[3,] 1 1 1 1 1 1 1 1 1 1
[4,] 1 1 1 1 1 1 1 1 1 1
[5,] 1 1 1 1 1 1 1 1 1 1
[6,] 1 1 1 1 1 1 1 1 1 1
[7,] 1 1 1 1 1 1 1 1 1 1
[8,] 1 1 1 1 1 1 1 1 1 1
[9,] 1 1 1 1 1 1 1 1 1 1
[10,] 1 1 1 1 1 1 1 1 1 1
#assume that the positions to insert are 4 and 8
goal <- cbind(old[,c(1:3)],
vec,
old[,4:6], #attention, now old column 6 is new column 7
vec2,
old[,7:ncol(old)])
goal
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[1,] 1 1 1 5 1 1 1 8 1 1 1 1
[2,] 1 1 1 5 1 1 1 8 1 1 1 1
[3,] 1 1 1 5 1 1 1 8 1 1 1 1
[4,] 1 1 1 5 1 1 1 8 1 1 1 1
[5,] 1 1 1 5 1 1 1 8 1 1 1 1
[6,] 1 1 1 5 1 1 1 8 1 1 1 1
[7,] 1 1 1 5 1 1 1 8 1 1 1 1
[8,] 1 1 1 5 1 1 1 8 1 1 1 1
[9,] 1 1 1 5 1 1 1 8 1 1 1 1
[10,] 1 1 1 5 1 1 1 8 1 1 1 1
However, I could not think of something that works with both changing positions and number of vectors to insert.
Any help is greatly appreciated, thank you very much.
cbind the vectors onto old and then reorder. If we knew that no were already sorted then we could replace sort(no) with no.
no <- c(4, 8)
vecs <- cbind(vec, vec2)
cbind(old, vecs)[, order(c(1:ncol(old), sort(no) - seq_along(no))) ]
Extending G. Grothendiecks approach and solving the ordering problem:
pos<-c(4,8)
pos<-pos-c(1:length(pos))
cbind(old, vec, vec2)[, order(c(1:ncol(old), c(pos)))]
Edit: Sorry, didn't see the edit of the answer above :)

How to find all the possible permutations of a matrix in R?

I have a matrix, for example, 5x5.
[,1] [,2] [,3] [,4] [,5]
[1,] 22 -2 -2 -2 2
[2,] -2 22 2 2 2
[3,] -2 2 22 2 2
[4,] -2 2 2 22 2
[5,] 2 2 2 2 22.
As you can see, the matrix is symmetric.
Above the main diagonal, there are 4+3+2+1=10 positions, and I find via combn all the possible (permutation) matrices, which have (-2) 3 times in these 10 positions. That means 10!/3!*7!=120 matrices.
But some of them are equivalent.
So,my problem is how to find the non-equivalent matrices from the 120.
I am taking about permutation matrices, because if I pick one of the 120 matrices and I use rmperm, I have as a result one (random) of the 120 matrices.
When I have 5x5 and 6x6 matrices, I don't have problem, because I have developed an algorithm. But now I want to do the same in a 7x7 matrix and more, but the algorithm is very slow, because I have lots of loops.
So, I want with one command, when I pick a matrix from the 120 matrices, to give me ALL the permutations matrices from the 120.
Thanks a lot!
Basically, you're asking for all row/column permutations. For an n x n matrix there are n! (n factorial) permutations of the rows and n! permutations of the columns, for a total of (n!)^2 total row/column permutations (not all of which are necessarily unique).
The first step would be to obtain a sample dataset and get the set of all permutations of the row/column indices (I'm assuming square matrices but it would be easy to extend to the non-square case):
# Sample dataset:
library(sna)
set.seed(100)
(g <- rgraph(3))
# [,1] [,2] [,3]
# [1,] 0 0 1
# [2,] 1 0 0
# [3,] 1 1 0
# All permutations of indices
library(gtools)
(perms <- permutations(nrow(g), nrow(g)))
# [,1] [,2] [,3]
# [1,] 1 2 3
# [2,] 1 3 2
# [3,] 2 1 3
# [4,] 2 3 1
# [5,] 3 1 2
# [6,] 3 2 1
You can compute all pairings of the row/column orderings, which you can use to grab all possible row/column permutations:
pairings <- expand.grid(1:nrow(perms), 1:nrow(perms))
head(pairings)
# Var1 Var2
# 1 1 1
# 2 2 1
# 3 3 1
# 4 4 1
# 5 5 1
# 6 6 1
all.perms <- lapply(1:nrow(pairings), function(x) g[perms[pairings[x,1],], perms[pairings[x,2],]])
head(all.perms)
# [[1]]
# [,1] [,2] [,3]
# [1,] 0 0 1
# [2,] 1 0 0
# [3,] 1 1 0
#
# [[2]]
# [,1] [,2] [,3]
# [1,] 0 0 1
# [2,] 1 1 0
# [3,] 1 0 0
# ...
Finally, you can use unique to grab the elements of all.perms that are unique matrices:
all.unique.perms <- unique(perms)
length(all.unique.perms)
# [1] 18
Basically what you want is permutation of multiset. The package iterpc will do the job.
> library(iterpc)
> I <- iterpc(c(3,7), ordered=TRUE)
> getlength(I)
[1] 120
> getall(I)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 1 1 2 2 2 2 2 2 2
[2,] 1 1 2 1 2 2 2 2 2 2
[3,] 1 1 2 2 1 2 2 2 2 2
[4,] 1 1 2 2 2 1 2 2 2 2
[5,] 1 1 2 2 2 2 1 2 2 2
[6,] 1 1 2 2 2 2 2 1 2 2
[7,] 1 1 2 2 2 2 2 2 1 2
[8,] 1 1 2 2 2 2 2 2 2 1
[9,] 1 2 1 1 2 2 2 2 2 2
[10,] 1 2 1 2 1 2 2 2 2 2
[11,] 1 2 1 2 2 1 2 2 2 2
[12,] 1 2 1 2 2 2 1 2 2 2
[13,] 1 2 1 2 2 2 2 1 2 2
[14,] 1 2 1 2 2 2 2 2 1 2
[15,] 1 2 1 2 2 2 2 2 2 1
[16,] 1 2 2 1 1 2 2 2 2 2
[17,] 1 2 2 1 2 1 2 2 2 2
[18,] 1 2 2 1 2 2 1 2 2 2
[19,] 1 2 2 1 2 2 2 1 2 2
[20,] 1 2 2 1 2 2 2 2 1 2
[ reached getOption("max.print") -- omitted 100 rows ]
Each row here is a permutations of 1 and 2. You should replace the 1's by -2.

Create table with subtotal per row and per column

I know how to create table in R using table, like this:
x <- rep(1:3,4)
y <- rep(1:4,3)
z<- cbind(x,y)
table(z[,1],z[,2])
1 2 3 4
1 1 1 1 1
2 1 1 1 1
3 1 1 1 1
How can I add the margin total of the table to making it looks like:
1 2 3 4
1 1 1 1 1 4
2 1 1 1 1 4
3 1 1 1 1 4
3 3 3 3
> a
[,1] [,2] [,3]
[1,] 1 1 1
[2,] 1 1 1
[3,] 1 1 1
> a <- cbind(a, rowSums(a))
> a <- rbind(a, colSums(a))
> a
[,1] [,2] [,3] [,4]
[1,] 1 3 1 5
[2,] 1 1 1 3
[3,] 1 1 1 3
[4,] 3 5 3 11
Another approach:
a <- addmargins(a, c(1, 2), sum)

Resources