Given a random matrix (any size!), write a function that determines whether or not that matrix is a Toeplitz Matrix. In linear algebra, a Toeplitz matrix is one in which the elements on any given diagonal from top left to bottom right are identical.
Here is an example:
x <- structure(c(1, 5, 4, 7, 2, 1, 5, 4, 3, 2, 1, 5, 4, 3, 2, 1, 8,
4, 3, 2), .Dim = 4:5)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 2 3 4 8
[2,] 5 1 2 3 4
[3,] 4 5 1 2 3
[4,] 7 4 5 1 2
So our function should receive such matrix and return TRUE if it meets the conditions.
To test the function, one can use stats::toeplitz() to generate a toeplitz matrix. So for example, the expected output of our function should be:
> toeplitz_detector(stats::toeplitz(sample(5, 5)))
> [1] TRUE
I've solved the problem by defining the following function:
toeplitz_solver <- function(a) {
# re-order a backwards, because we need to check diagonals from top-left
# to bottom right. if we don't reorder, we'll end up with top-right to
# bottom-left.
a <- a[, ncol(a):1]
# get all i and j (coordinates for every element)
i <- 1:nrow(a)
j <- 1:ncol(a)
# get all combinations of i and j
diags <- expand.grid(i, j)
# the coordinates for the diagonals are the ones where
# the sum is the same, e.g.: (3,2), (4,1), (2,3), (1,4)
sums <- apply(diags, 1, sum)
indexes <- lapply(unique(sums), function(x) {
diags[which(sums == x), ]
})
# indexes is now a list where every element is a list of coordinates
# the first element is a list for every coordinates for the first diag
# so on and so forth
results <- sapply(indexes, function(x) {
y <- a[as.matrix(x)]
return(all(y == y[1]))
})
# if every diagonal meets the condition, it is safe to assume that the
# input matrix is in fact toeplitz.
return(all(results))
}
Related
Is there a compact and elegant way to create an adjacency matrix given a vector of the form shown (see code excerpt) in base R?
I give my best attempt below. Ideally, I would like to create the already-populated adjacency matrix in a single step as opposed to having to create the matrix data structure then fill it.
p <- 25 # Cardinality of vertex set; Number of nodes
hypothesis_path <- c(17, 7, 6, 1) # path in this form
path_to_D <- function(hypothesis_path, p) {
path_len <- length(hypothesis_path) - 1
idx_path <- t(sapply(1:path_len, function(i) hypothesis_path[i:(i+1)]))
D <- matrix(0, p, p); D[idx_path] <- 1
D
}
D <- path_to_D(hypothesis_path, p)
which(D == 1, arr.ind = TRUE)
# Desired indices of adjacency matrix are populated (with ones)
# row col
# [1,] 6 1
# [2,] 7 6
# [3,] 17 7
Acceptable answers will avoid use of igraph or similar and will use the path vector in the form given. That said, advice and alternatives are of course always welcomed and appreciated.
You can use a sparse matrix from the Matrix package. It is not base R but a very common package.
library(Matrix)
hypothesis_path <- c(17, 7, 6, 1)
D <- sparseMatrix(i = hypothesis_path[-length(hypothesis_path)],
j = hypothesis_path[-1])
which(D == 1, arr.ind = TRUE)
row col
[1,] 6 1
[2,] 7 6
[3,] 17 7
You can use the powerful but little-known trick of matrix-based indexing:
index_mat <- rbind(
c(1, 2),
c(2, 3),
c(3, 1)
)
mat <- matrix(FALSE, 3, 3)
mat[index_mat] <- TRUE
mat
[,1] [,2] [,3]
[1,] FALSE TRUE FALSE
[2,] FALSE FALSE TRUE
[3,] TRUE FALSE FALSE
So do this:
path_to_D <- function (path, p) {
indices <- cbind(path[-length(path)], path[-1])
D <- matrix(0, p, p)
D[indices] <- 1
D
}
D <- path_to_D(hypothesis_path, 25)
which(D == 1, arr.ind=TRUE)
row col
[1,] 6 1
[2,] 7 6
[3,] 17 7
How to easily replace a (N x 1) vector/column of a (N x M) matrix by a (N x K) matrix such that the result is a (N x (M - 1 + K)) matrix?
Example:
a <- matrix(c(1, 3, 4, 5), nrow = 2) # (2 x 2)
b <- matrix(c(1, 3, 5, 6, 7, 7), nrow = 2) # (2 x 3)
I now want to do something like this:
a[, 1, drop = FALSE] <- b # Error
which R does not like.
All I could think of is a two-step approach: attach b to a and subsequently delete column 1. Problem: it mixes the order the columns appear.
Basically, I want to have a simple drop in replacement. I am sure it is possible somehow.
You can use cbind:
cbind(b, a[,-1])
# [,1] [,2] [,3] [,4]
#[1,] 1 5 7 4
#[2,] 3 6 7 5
If you need to insert in the middle of a large matrix (say, at column N), rather than one end you can use,
cbind(a[, 1:(N-1)], b, a[, (N+1):NCOL(a)])
For a generalized version that works wherever the insert is (start, middle or end) we can use
a <- matrix(1:10, nrow = 2)
b <- matrix(c(100, 100, 100, 100, 100, 100), nrow = 2)
N <- 6 # where we want to insert
NMAX <- NCOL(a) # the largest column where we can insert
cbind(a[, 0:(N-1)], b, {if(N<NMAX) a[,(N+1):NMAX] else NULL})
I have been trying to write a generalized function that multiplies each value in each row of a matrix by the corresponding value of a vector in terms of their position (i.e. matrix[1,1]*vector[1], matrix[1,2]*vector[2], etc) and then sum them together. It is important to note that the lengths of the vector and the rows of the matrix are always the same, which means that in each row the first value of the vector is multiplied with the first value of the matrix row. Also important to note, I think, is that the rows and columns of the matrix are of equal length. The end sum for each row should be assigned to different existing vector, the length of which is equal to the number of rows.
This is the matrix and vector:
a <- c(4, -9, 2, -1)
b <- c(-1, 3, -8, 2)
c <- c(5, 2, 6, 3)
d <- c(7, 9, -2, 5)
matrix <- cbind(a,b,c,d)
a b c d
[1,] 4 -1 5 7
[2,] -9 3 2 9
[3,] 2 -8 6 -2
[4,] -1 2 3 5
vector <- c(1, 2, 3, 4)
These are the basic functions that I have to generalize for the rows and columns of matrix and a vector of lenghts "n":
f.1 <- function() {
(matrix[1,1]*vector[1]
+ matrix[1,2]*vector[2]
+ matrix[1,3]*vector[3]
+ matrix[1,4]*vector[4])
}
f.2 <- function() {
(matrix[2,1]*vector[1]
+ matrix[2,2]*vector[2]
+ matrix[2,3]*vector[3]
+ matrix[2,4]*vector[4])
}
and so on...
This is the function I have written:
ncells = 4
f = function(x) {
i = x
result = 0
for(j in 1:ncells) {
result = result + vector[j] * matrix[i][j]
}
return(result)
}
Calling the function:
result.cell = function() {
for(i in 1:ncells) {
new.vector[i] = f(i)
}
}
The vector to which this result should be assigned (i.e. new.vector) has been defined beforehand:
new.vector <- c()
I expected that the end sum for each row will be assigned to the vector in a corresponding manner (e.g. if the sums for all rows were 1, 2, 3, 4, etc. then new.vector(1, 2, 3, 4, etc) but it did not happen.
(Edit) When I do this with the basic functions, the assignment works:
new.vector[1] <- f.1()
new.vector[2] <- f.2()
This does not however work with the generalized function:
new.vector[1:ncells] <- result cell[1:ncells]
(End Edit)
I have also tried setting the length for the the new.vector to be equal to ncells but I don't think it did any good:
length(new.vector) = ncells
My question is how can I make the new vector take the resulting sums of the multiplied elements of a row of a matrix by the corresponding value of a vector.
I hope I have been clear and thanks in advance!
There is no need for a loop here, we can use R's power of matrix multiplication and then sum the rows with rowSums. Note that m and v are used as names for matrix and vector to avoid conflict with those function names.
nr <- nrow(m)
rowSums(m * matrix(rep(v, nr), nr, byrow = TRUE))
# [1] 45 39 -4 32
However, if the vector v is always going to be the column number, we can simply use the col function as our multiplier.
rowSums(m * col(m))
# [1] 45 39 -4 32
Data:
a <- c(4, -9, 2, -1)
b <- c(-1, 3, -8, 2)
c <- c(5, 2, 6, 3)
d <- c(7, 9, -2, 5)
m <- cbind(a, b, c, d)
v <- 1:4
Given an n dimensional array X, a d by d-1 dimensional matrix V and two specified dimensions (p1, p2) <= (n, n); I would like a function that preforms matrix multiplication of V along the dimensions (p1, p2) of X.
That is given X:
library(abind)
set.seed(4)
X <- matrix(runif(4), 2, 2)
X <- abind(x, x+5, along = 3)
> a
, , 1
[,1] [,2]
[1,] 1 3
[2,] 2 4
, , 2
[,1] [,2]
[1,] 6 8
[2,] 7 9
and given a matrix V
V <- matrix(c(1, 2))
[,1]
[1,] 1
[2,] 2
For example, if p1=2 and p2=1 I would like to remove the following for loop
p1 <- 1
p2 <- 2
a.out <- array(0, c(2, 1, 2))
for (i in 1:dim(a)[2]){
a.out[,,i] <- a[,,i]%*%V # note indexed along other dimension
}
> a.out
, , 1
[,1]
[1,] 7
[2,] 10
, , 2
[,1]
[1,] 22
[2,] 25
The hard part here is that I want to allow for arbitrary dimensional arrays (i.e., n could be greater than 3).
1st Edit:
This problem is not the same as Indexing slice from 3D Rcpp NumericVector as I am discussing arbitrary number of dimensions >=2 and the question is not only about indexing.
2nd Edit:
Just to be a little more clear here is another example of what I am trying to do. Here the dimension of X is 4, p1 = 2, p3=3, and the dimension of X along the p1 dimension is 12. The following code computes the desired result as X.out for random X and V.
X <- array(rnorm(672), c(4, 7, 12, 2))
V <- matrix(rnorm(132), 12, 11) # p1 = 2, p2 = 3, V is of dimension D x D-1
d <- dim(X)
X.out <- array(0, dim=c(d[1:2], d[3]-1, d[4]))
for(i in 1:d[1]){
for (j in 1:d[4]){
X.out[i,,,j] <- X[i,,,j]%*%V # p1 = 2, p2 = 3
}
}
How can I simply pad (append/prepend) a slice of NA's to a (say) 3D array along (say) dimension 2?
Suppose the initial array is given as
A <- array(1:8,c(2,2,2))
I initially thought this would work:
cbind(A,NA)
but it results in an 8x2 matrix instead of a 2x3x2 array. I then tried
abind(A,NA,along=2)
but that results in an error.
I'm hoping there is a much simpler solution than
dimSlice <- dim(A)
dimSlice[2] <- 1
abind(A,array(NA,dimSlice),along=2)
Background
This padding happens as part of a "remove slice and pad opposite side" operation that shifts an array by one position along some dimension, filling in with NA elements at the vacated positions. The one-dimensional equivalent would be, for example, c(A[-1],NA) for vector A, If there is a simple way to accomplish such an operation without an explicit padding sub-operation, that would be even better.
Subsetting with NAs results in NAs (?Extract):
v = 1:3; m = matrix(1:4, 2, 2); a = array(1:6, c(2, 2, 2))
v[c(NA, 1)]
#[1] NA 1
m[, c(2, NA)]
# [,1] [,2]
#[1,] 3 NA
#[2,] 4 NA
a[, c(1, 2, NA), ]
#, , 1
#
# [,1] [,2] [,3]
#[1,] 1 3 NA
#[2,] 2 4 NA
#
#, , 2
#
# [,1] [,2] [,3]
#[1,] 5 1 NA
#[2,] 6 2 NA
So, to pad with NAs, we could subset using the appropriate indices. Putting the above in a more general function to append/prepend "n" indices with NA in dimension "k" of an array:
pad = function(x, k, n = 1L, append = TRUE)
{
dims = replicate(length(dim(x)), substitute(), simplify = FALSE)
if(append) dims[[k]] = c((n + 1):dim(x)[[k]], rep_len(NA, n))
else dims[[k]] = c(rep_len(NA, n), 1:(dim(x)[[k]] - n))
do.call("[", c(list(x), dims))
}
arr = array(1:24, c(3, 2, 2, 2))
pad(arr, 1, 2, FALSE)
pad(arr, 2)