Related
So I'm using r and I'd like to make a code that takes a value of n, creates a n x n matrix that has alternating 1's and 0's.
E.g:
I can't seem to do this without getting an error or warning and it won't work for all integers of n, any help would be appreciated, thanks.
what about this?
n <- 5L
matrix(seq(1:n^2) %% 2, nrow = n)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 1 0 1
[2,] 0 1 0 1 0
[3,] 1 0 1 0 1
[4,] 0 1 0 1 0
[5,] 1 0 1 0 1
Try the code below
m <- matrix(rep_len(c(1, 0), n^2), n)
or
m <- replace(m <- diag(n), !((row(m) - col(m)) %% 2), 1)
which gives
> m
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 1 0 1
[2,] 0 1 0 1 0
[3,] 1 0 1 0 1
[4,] 0 1 0 1 0
[5,] 1 0 1 0 1
I have a binary vector that holds information on whether or not some event happened for some observation:
v <- c(0,1,1,0)
What I want to achieve is a matrix that holds information on all bivariate pairs of observations in this vector. That is, if two observations both have 0 or both have 1 in this vector v, they should get a 1 in the matrix. If one has 0 and the other has 1, they should get a 0 otherwise.
Hence, the goal is this matrix:
[,1] [,2] [,3] [,4]
[1,] 0 0 0 1
[2,] 0 0 1 0
[3,] 0 1 0 0
[4,] 1 0 0 0
Whether the main diagonal is 0 or 1 does not matter for me.
Is there an efficient and simple way to achieve this that does not require a combination of if statements and for loops? v might be of considerable size.
Thanks!
We can use outer
out <- outer(v, v, `==`)
diag(out) <- 0L # as you don't want to compare each element to itself
out
# [,1] [,2] [,3] [,4]
#[1,] 0 0 0 1
#[2,] 0 0 1 0
#[3,] 0 1 0 0
#[4,] 1 0 0 0
Another option with expand.grid is to create pairwise combinations of v with itself and since you have values of only 0 and 1, we can find values with 0 and 2. (0 + 0 and 1 + 1).
inds <- rowSums(expand.grid(v, v))
matrix(+(inds == 0 | inds == 2), nrow = length(v))
# [,1] [,2] [,3] [,4]
#[1,] 1 0 0 1
#[2,] 0 1 1 0
#[3,] 0 1 1 0
#[4,] 1 0 0 1
Since, the diagonal element are not important for you, I will keep it as it is or if you want to change you can use diag as shown in #markus's answer.
Another (slightly less efficient) approach than the use of outer would be sapply:
out <- sapply(v, function(x){
x == v
})
diag(out) <- 0L
out
[,1] [,2] [,3] [,4]
[1,] 0 0 0 1
[2,] 0 0 1 0
[3,] 0 1 0 0
[4,] 1 0 0 0
microbenchmark on a vector of length 1000:
> test <- microbenchmark("LAP" = sapply(v, function(x){
+ x == v
+ }),
+ "markus" = outer(v, v, `==`), times = 1000, unit = "ms")
> test
Unit: milliseconds
expr min lq mean median uq max neval
LAP 3.973111 4.065555 5.747905 4.573002 6.324607 101.03498 1000
markus 3.515725 3.535067 4.852606 3.694924 4.908930 84.85184 1000
If you allow the main diagonal to be 1, then there will always be two unique rows v and 1 - v in this matrix no matter how large v is. Since the matrix is symmetric, it also has two such unique columns. This makes it trivial to construct this matrix.
## example `v`
set.seed(0)
v <- sample.int(2, 10, replace = TRUE) - 1L
#[1] 1 0 0 1 1 0 1 1 1 1
## column expansion from unique columns
cbind(v, 1 - v, deparse.level = 0L)[, 2 - v]
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,] 1 0 0 1 1 0 1 1 1 1
# [2,] 0 1 1 0 0 1 0 0 0 0
# [3,] 0 1 1 0 0 1 0 0 0 0
# [4,] 1 0 0 1 1 0 1 1 1 1
# [5,] 1 0 0 1 1 0 1 1 1 1
# [6,] 0 1 1 0 0 1 0 0 0 0
# [7,] 1 0 0 1 1 0 1 1 1 1
# [8,] 1 0 0 1 1 0 1 1 1 1
# [9,] 1 0 0 1 1 0 1 1 1 1
#[10,] 1 0 0 1 1 0 1 1 1 1
What is the purpose of this matrix?
If there are n0 zeros and n1 ones, the matrix will have dimension (n0 + n1) x (n0 + n1), but there are only (n0 x n0 + n1 x n1) ones in the matrix. So for long vector v, the matrix is sparse. In fact, it has super sparsity, as it has large number of duplicated rows / columns.
Obviously, if you want to store the position of 1 in this matrix, you can simply get it without forming this matrix at all.
Let's start with the following matrix.
M <- matrix(c(0,0,1,1,0,0,1,1,
0,1,1,0,0,1,1,0,
0,0,0,0,1,1,1,1,
0,1,0,1,1,0,1,0,
0,0,1,1,1,1,0,0,
0,1,1,0,1,0,0,1),nrow = 8,ncol = 6)
Here is the M
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 0 0 0
[2,] 0 1 0 1 0 1
[3,] 1 1 0 0 1 1
[4,] 1 0 0 1 1 0
[5,] 0 0 1 1 1 1
[6,] 0 1 1 0 1 0
[7,] 1 1 1 1 0 0
[8,] 1 0 1 0 0 1
If I pick a random column, say 4, I want to swap two positions in that column. One such possibility is swapping 5th and 6th position is given by
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 0 0 0
[2,] 0 1 0 1 0 1
[3,] 1 1 0 0 1 1
[4,] 1 0 0 1 1 0
[5,] 0 0 1 0 1 1
[6,] 0 1 1 1 1 0
[7,] 1 1 1 1 0 0
[8,] 1 0 1 0 0 1
I want to do this for every possible swap in each column and then for all columns to obtain all the possible matrices.
Here's another solution:
# Return all unique permutations for c(0,0,0,0,1,1,1,1)
library(gtools)
perms = unique(permutations(8, 8, M[,1], set = FALSE))
# Create nested list
Mat_list = lapply(vector("list", ncol(M)), function(x) vector("list", nrow(perms)))
# Loop through every column and every permutations replacing each column
# with each unique permutation one at a time
for(ii in 1:ncol(M)){
for(jj in 1:nrow(perms)){
New_Mat = M
New_Mat[,ii] = perms[jj,]
Mat_list[[ii]][[jj]] = New_Mat
}
}
Result:
> Mat_list[[1]][[2]]
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 0 0 0
[2,] 0 1 0 1 0 1
[3,] 1 1 0 0 1 1
[4,] 1 0 0 1 1 0
[5,] 0 0 1 1 1 1
[6,] 1 1 1 0 1 0
[7,] 0 1 1 1 0 0
[8,] 1 0 1 0 0 1
Note:
Instead of creating a super long list, I've created a nested list of matrices with 8 elements and n sub-elements per element (where n is the number of unique permutations). You can unlist the result if you prefer the long list form.
This code gives every permutation of 0s and 1s by column. I used a smaller toy example here, because the number of possibilities can get very large -- prod(choose(nrow(M), colSums(M))). As a note, this will likely not run on a standard computer for the matrix given, because of memory requirements.
library(gtools)
set.seed(1234)
M <- matrix(sample(0:1, 16, replace = TRUE), ncol = 4)
M
# [,1] [,2] [,3] [,4]
# [1,] 0 1 1 0
# [2,] 1 1 1 1
# [3,] 1 0 1 0
# [4,] 1 0 1 1
perm1s <- function(n, N) {
unique(permutations(N, N, c(rep(0, N - n), rep(1, n)), FALSE, FALSE))
}
createMat <- function(vec, lst) {
tmp <- lapply(seq_along(vec), function(x) lst[[x]][vec[x], ])
do.call(cbind, tmp)
}
makeMats <- function(M) {
sums <- colSums(M)
rows <- nrow(M)
rowPerm <- lapply(sums, perm1s, N = rows)
comb <- expand.grid(lapply(sapply(rowPerm, nrow), seq))
comb <- lapply(split(comb, seq(nrow(comb))), unlist)
mats <- lapply(comb, createMat, lst = rowPerm)
mats
}
res <- makeMats(M)
res[[1]]
# [,1] [,2] [,3] [,4]
# [1,] 0 0 1 0
# [2,] 1 0 1 0
# [3,] 1 1 1 1
# [4,] 1 1 1 1
To hold other columns constant when varying 1 column -- sum(choose(nrow(M), colSums(M))) possibilities:
makeMats2 <- function(M) {
sums <- colSums(M)
rows <- nrow(M)
rowPerm <- lapply(sums, perm1s, N = rows)
ind <- rep(seq_along(rowPerm), sapply(rowPerm, nrow))
rowPerm <- lapply(rowPerm, function(x) split(x, seq(nrow(x))))
rowPerm <- unlist(rowPerm, recursive = FALSE)
mats <- rep(list(M), length(rowPerm))
mats <- mapply(function(x, y, z) {x[ , y] <- z; x},
x = mats, y = ind, z = rowPerm, SIMPLIFY = FALSE)
mats
}
Suppose I have three matrices:
Mat1 = matrix(0,4,4)
Mat2 = matrix(0,4,4)
Mat3 = matrix(0,4,4)
Then suppose that I need to create numbers of matrix is very difficult to do that manually. Also, I want to make these function as a low triangle matrix using low.tri(Mat1), so is there any way to do that easly.
I search lapply families but could not find the answer for my question.
lapply is used on lists. First, you insert all your matrices in a list. lower.tri is a logical function. If you want to get a lower triangle, you should create a function similar to f below. Then you can use lapply like so:
Mat1 = matrix(0,4,4)
Mat2 = matrix(0,4,4)
Mat3 = matrix(0,4,4)
l <- list(Mat1,Mat2,Mat3)
f <- function(m) {
m[lower.tri(m)] <- 1
m
}
lapply(l,f)
[[1]]
[,1] [,2] [,3] [,4]
[1,] 0 0 0 0
[2,] 1 0 0 0
[3,] 1 1 0 0
[4,] 1 1 1 0
[[2]]
[,1] [,2] [,3] [,4]
[1,] 0 0 0 0
[2,] 1 0 0 0
[3,] 1 1 0 0
[4,] 1 1 1 0
[[3]]
[,1] [,2] [,3] [,4]
[1,] 0 0 0 0
[2,] 1 0 0 0
[3,] 1 1 0 0
[4,] 1 1 1 0
I want to insert a set of n values expressed as a vector into a corresponding set of locations in a matrix. The real-world application involves inserting a set of n sea surface temperature values into an image of a region that is represented as a grid with dimension nrow x ncol > n in for which I have identified the n water pixels that should receive the temperature values. The problem I've run into is that the temperature values are ordered as if they were from a column-major matrix rather than the row-major ordering used to index the R grid.
Here is a toy example of what I mean.
> grid <- matrix(0,4,4)
> grid # define the base grid
[,1] [,2] [,3] [,4]
[1,] 0 0 0 0
[2,] 0 0 0 0
[3,] 0 0 0 0
[4,] 0 0 0 0
> temps <- c(9,9,9,9,9) # we have 5 temperature values
> locs <- c(2,3,4,6,7) # locations in the base grid that are water
> grid[locs] <- temps # not really what I want - substitution in row-major order
> grid
[,1] [,2] [,3] [,4]
[1,] 0 0 0 0
[2,] 9 9 0 0
[3,] 9 9 0 0
[4,] 9 0 0 0
The desired result would be rather:
[,1] [,2] [,3] [,4]
[1,] 0 9 9 9
[2,] 0 9 9 0
[3,] 0 0 0 0
[4,] 0 0 0 0
I suppose I could play with transposing the grid, doing the substitution and then transposing it back, but I'd think there would be a better way to approach this problem.
Here are a couple of options, each of which works on matrices of arbitrary dimension:
arrayIndByRow <- function(ind, dim) {
arrayInd(ind, rev(dim))[,2:1]
}
grid[arrayIndByRow(locs, dim(grid))] <- temps
grid
# [,1] [,2] [,3] [,4]
# [1,] 0 9 9 9
# [2,] 0 9 9 0
# [3,] 0 0 0 0
# [4,] 0 0 0 0
f <- function(ind, dim) {
nr <- dim[1]
nc <- dim[2]
ii <- ind - 1
((ii %/% nc) + 1) + nr*(ii %% nc)
}
grid[f(locs, dim(grid))] <- 1:5
grid
# [,1] [,2] [,3] [,4]
# [1,] 0 1 2 3
# [2,] 0 4 5 0
# [3,] 0 0 0 0
# [4,] 0 0 0 0
If you have a square matrix, you could write a little modulo function that replaces your numbers with the correct ones:
new_num <- function(x,num_rows){
x = x - 1
row <- x %/% num_rows
column <- x %% num_rows
newnum <- column * num_rows + row + 1
return(newnum)
}
temps <- c(9,9,9,9,9)
locs <- c(2,3,4,6,7)
new_locs <- new_num(locs,4)
M <- matrix(0,4,4)
M[new_locs] <- temps
You can do this with a non-square matrix too, it's just a bit harder.
You could do some work with the indices. First we make a sequence the length of the matrix by the number of columns. Then we iteratively add 1 to the sequence. We do that for the number of rows. Then subsetting that vector for the location vector will give us the location in the matrix.
x <- seq(1, length(grid), ncol(grid))
grid[sapply(0:(nrow(grid)-1), "+", x)[locs]] <- temps
grid
# [,1] [,2] [,3] [,4]
# [1,] 0 9 9 9
# [2,] 0 9 9 0
# [3,] 0 0 0 0
# [4,] 0 0 0 0
One way to do this is to create a new matrix with the required data, specifying byrow=TRUE when it is created. To do this, you have to create an intermediate vector to store and modify the data of grid:
grid <- matrix(rep(0,16),ncol=4)
##
temps <- c(9,9,9,9,9)
locs <- c(2,3,4,6,7)
##
#vgrid <- as.numeric(grid)
vgrid <- c(grid)
vgrid[locs] <- temps
##
> matrix(vgrid,ncol=ncol(grid),byrow=TRUE)
[,1] [,2] [,3] [,4]
[1,] 0 9 9 9
[2,] 0 9 9 0
[3,] 0 0 0 0
[4,] 0 0 0 0