I have a matrix called my_matrix with 5 rows and 5 columns made up with 1s and 0s.
test.matrix <- matrix(c(0,0,1,0,0,0,1,1,1,0,0,1,1,1,0,0,0,0,1,0,0,1,0,0,1),nrow=5)
test.matrix
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 0 1 1 0 1
[3,] 1 1 1 0 0
[4,] 0 1 1 1 0
[5,] 0 0 0 0 1
I want to find a left2tile pattern of test.matrix as shown:
[,1] [,2]
[1,] 1 0
[2,] 1 0
I also want to find a right2tile pattern of test.matrix as shown:
[,1] [,2]
[1,] 0 1
[2,] 0 1
For left2tile I want to find the number of unique 2-tiles in the matrix where the leftmost two entries are 1 and the rightmost two entries are 0.
For right2tile I want to find the number of unique 2-tiles in the matrix where the rightmost two entries are 1 and the leftmost two entries are 0.
I'm aware that these may overlap. Any idea how to calculate this in R?
Here are example functions that can tell you how many 2x2 matrices in the bigger matrix match the provided 2x2 matrix. The first helper function creates a list of 2x2 matrices that the input matrix is made of. The second function uses the first helper function and returns how many of the first matrix argument is in the second matrix argument.
# Helper functions
decompose=function(x) {
two_by_two=list()
k=1
for (i in 1:(nrow(x)-1)) {
for (j in 1:(ncol(x)-1)) {
two_by_two[[k]]=matrix(c(x[i,j], x[i+1,j], x[i,j+1], x[i+1,j+1]), ncol=2)
k=k+1
}
}
return(two_by_two)
}
how_many=function(x, test) {
my_list=decompose(test)
bools=sapply(my_list, function(y) {
return(identical(x, y))
})
return(sum(bools))
}
#Carrying it out
left2tile=matrix(c(1,1,0,0), ncol=2)
right2tile=matrix(c(0,0,1,1),ncol=2)
how_many(left2tile, test.matrix)
how_many(right2tile, test.matrix)
Related
Suppose I have a list of matrices. Suppose further I have found the smallest values by the column.
Here is my last question
I really need to know from which matrix each smallest value is selected. My original function is very complicated. Therefore, I provided a simple example. I have one idea and really do not know to implement it correctly in R.
My idea is:
Suppose that [i,j] is the elements of the matrix. Then,
if(d[[1]][i,j] < d[[2]][i,j]){
d[[1]][i,j] <– "x"
}else { d[[2]][i,j] <– "z"}
So, I would like to sign the name of the matrix that corresponds to each smallest value. Then, store the names in a separate matrix. So, then I can see the values in one matrix and their corresponding names (from where they come from) in another matrix
For example,
y <- c(3,2,4,5,6, 4,5,5,6,7)
x[lower.tri(x,diag=F)] <- y
> x
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 3 0 0 0 0
[3,] 2 6 0 0 0
[4,] 4 4 5 0 0
[5,] 5 5 6 7 0
k <- c(1,4,5,2,5,-4,4,4,4,5)
z[lower.tri(z,diag=F)] <- k
> z
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 1 0 0 0 0
[3,] 4 5 0 0 0
[4,] 5 -4 4 0 0
[5,] 2 4 4 5 0
d <- list(z, x)
Then:
do.call(pmin, d) (answered by #akrun)
Then, I will only get the matrix with smallest values. I would like to know where each value is come from?
Any idea or help, please?
You can use Map and do.call to create your own functions that will be applied element-wise to a list of inputs,
in your case a list of matrices.
pwhich.min <- function(...) {
which.min(c(...)) # which.min takes a single vector as input
}
di <- unlist(do.call(Map, c(list(f = pwhich.min), d)))
dim(di) <- dim(x) # take dimension from one of the inputs
di
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 1 1
[2,] 2 1 1 1 1
[3,] 1 2 1 1 1
[4,] 1 2 2 1 1
[5,] 2 2 2 2 1
EDIT:
To elaborate,
you could do something like Map(f = min, z, x) to apply min to each pair of values in z and x,
although in that case min already supports arbitrary amount of inputs through an ellipsis (...).
By contrast,
which.min only takes a single vector as input,
so you need a wrapper with an ellipsis that combines all values into a vector
(pwhich.min above).
Since you may want to have more than two matrices,
you can put them all in a list,
and use do.call to put each element in the list as a parameter to the function you specify in f.
Or another option would be to convert it to a 3D array and use apply with which.min
apply(array(unlist(d), c(5, 5, 2)), c(1, 2), which.min)
Or with pmap from purrr
library(purrr)
pmap_int(d, ~ which.min(c(...))) %>%
array(., dim(x))
I want to get the row-column coordinates for all nonzero elements in a matrix M. If M isn't too big, it's straightforward:
m <- matrix(sample(0:1, 25, TRUE, prob=c(0.75, 0.25)), 5, 5)
#[,1] [,2] [,3] [,4] [,5]
#[1,] 0 0 0 0 0
#[2,] 1 1 0 0 0
#[3,] 0 0 0 1 0
#[4,] 0 0 1 0 0
#[5,] 0 0 0 0 0
nz <- which(m != 0)
cbind(row(m)[nz], col(m)[nz])
#[,1] [,2]
#[1,] 2 1
#[2,] 2 2
#[3,] 4 3
#[4,] 3 4
However, in my case M is a sparse matrix (created using the Matrix package), whose dimensions can be very large. If I call row(M) and col(M) like above, I'll be generating a couple of dense matrices the same size as M, which I definitely don't want to do.
Is there a way of getting a result like the above without creating dense matrices along the way?
I think you want
which(m!=0,arr.ind=TRUE)
Looking at showMethods("which"), it seems that this is set up to work efficiently with sparse matrices. You can also get the answer more directly (but inscrutably) for a sparse, column-oriented matrix by manipulating the internal #p (column pointer) and #i (row pointer) slots:
mm <- Matrix(m)
dp <- diff(mm#p)
cbind(mm#i+1,rep(seq_along(dp),dp))
How can I create a quadratic band matrix, where I give the diagonal and the first diagonal below and above the diagonal? I am looking for a function like
tridiag(upper, lower, main)
where length(upper)==length(lower)==length(main)-1 and returns, for example,
tridiag(1:3, 2:4, 3:6)
[,1] [,2] [,3] [,4]
[1,] 3 1 0 0
[2,] 2 4 2 0
[3,] 0 3 5 3
[4,] 0 0 4 6
Is there an efficient way to do it?
This function will do what you want:
tridiag <- function(upper, lower, main){
out <- matrix(0,length(main),length(main))
diag(out) <- main
indx <- seq.int(length(upper))
out[cbind(indx+1,indx)] <- lower
out[cbind(indx,indx+1)] <- upper
return(out)
}
Note that when the index to a matrix is a 2 column matrix, each row in that index is interpreted as the row and column index for a single value in the vector being assigned.
I have a matrix like this:
[,1] [,2] [,3]
[1,] 0 1 0
[2,] 1 1 0
[3,] 0 0 1
The ones in each row represent the maximum values per row for e.g. i had the matrix
[,1] [,2] [,3]
[1,] 11 32 12
[2,] 16 16 14
[3,] 19 18 27
Now in this matrix in the second row I had two same maximum values (16) which got replaced by two 1's in the second row in the previous matrix, now I want to remove duplicate maximum values in my rows of a matrix so in essence what I need is something like this:
[,1] [,2] [,3]
[1,] 0 1 0
[2,] 1 0 0
[3,] 0 0 1
i.e keep one maximum value per row at random (ties should be broken at random and only one maximum value kept) and make all the entries other than that zero. Please can any one provide me a code snippet to solve this problem.
Or you could use. This would be faster.
ret[cbind(seq_len(nrow(mat2)),max.col(mat2, "first"))] <- 1
ret
# [,1] [,2] [,3]
#[1,] 0 1 0
#[2,] 1 0 0
#[3,] 0 0 1
data
mat1 <- matrix(c(0,1,0, 1,1,0,0,0,1), ncol=3)
mat2 <- matrix(c(11,16,19, 32, 16, 18, 12, 14, 27), ncol=3)
ret <- matrix(0, ncol(mat1), nrow(mat1))
if mat is your original matrix,
Create an empty matrix full of zeros, of the correct size and dim
ret <- matrix(rep(0, length(mat)), ncol=ncol(mat))
assign the required values to 1. Note that which.max breaks tie by choosing the first occurrence.
ret[ cbind(seq(nrow(mat)), apply(mat, 1, which.max)) ] <- 1
ret
[,1] [,2] [,3]
[1,] 0 1 0
[2,] 1 0 0
[3,] 0 0 1
Alternatively, if you truly want to split ties at random, you would use something like this as the index to ret:
cbind(seq(nrow(mat)), apply(mat, 1, function(x)
sample(which(x == max(x)), 1)
))
I am trying to program tic-tac-toe in R - here are my two functions for making a move and evaluating all valid moves (the ones are X's, zeros are O's and NA is not taken yet):
move <- function(board,square,mark)
{
if (square < 1 || square > 9 || !is.na(board[square]))
{
return(NA)
}
else
board[square] <- mark
return(board)
}
valid.moves <- function(board)
{
return(which(is.na(board)))
}
Now setting up a test position, evaluating all valid moves and then make those moves...
test.last <- matrix(c(1,1,NA,0,NA,0,NA,0,1),nrow=3)
moves <- valid.moves(test.last)
move(test.last,moves,1)
...gives a result which I didn't intend:
[,1] [,2] [,3]
[1,] 1 0 1
[2,] 1 1 0
[3,] 1 0 1
I wanted to have three different boards with the respective valid moves (which will then be evaluated with another function whether it is a winning position) and not one board with all valid moves made at once.
I don't want to do this with a loop but the vectorization should not take place all at once 'inside' the move function but 'outside' of it - so basically I want to do the following without a loop (the eval.pos function to evaluate the position is of the form eval.pos <- function(board){}):
for (i in 1:length(moves))
{
after.moves <- move(test.last,moves[i],1)
print(after.moves)
print(eval.pos(after.moves))
}
How can I accomplish this without a loop?
move2 <- function(board, square, mark) {
lapply(square, function(x,i,value) `[<-`(x,i,value), x=board, value=mark)
}
Note that the anonymous function() is needed because [<- is primitive.
Expanding my suggestion in the comment. How to use matrix indices to generate a list of move options:
valid.moves <- function(board)
{
return(which(is.na(board), arr.ind=TRUE))
}
> moves <- valid.moves(test.last)
> moves
row col
[1,] 3 1
[2,] 2 2
[3,] 1 3
> lapply(1:3, function( mv) {start <- test.last
start[matrix(moves[mv,],ncol=2)] <- 1
start})
[[1]]
[,1] [,2] [,3]
[1,] 1 0 NA
[2,] 1 NA 0
[3,] 1 0 1
[[2]]
[,1] [,2] [,3]
[1,] 1 0 NA
[2,] 1 1 0
[3,] NA 0 1
[[3]]
[,1] [,2] [,3]
[1,] 1 0 1
[2,] 1 NA 0
[3,] NA 0 1