I have a few vectors that I would like to arrange into square matrices of the same dimensions for future multiplication. Some vectors are shorters than others so I would like to add zeros to the shorters ones so that all the resulting matrices are of the same dimension.
I tried to add 0 to the tail of the shorter vectors but I haven't been able to generate the reducible matrices that I want. Below are some pseudo data. Thank you for your time!
seq_a <- rep(1,4)
seq_b <- rep(1,3)
matA <- diag(seq_a)
matB <- matrix(c(diag(seq_b),0),nrow=4,ncol = 4)
[,1] [,2] [,3] [,4]
[1,] 1 1 1 0
[2,] 0 0 0 0
[3,] 0 0 1 1
[4,] 0 0 0 0
Warning message:
In matrix(c(diag(seq_c), 0), nrow = 4, ncol = 4) :
data length [10] is not a sub-multiple or multiple of the number of rows [4]
The desired matB should be
[,1] [,2] [,3] [,4]
[1,] 1 0 0 0
[2,] 0 1 0 0
[3,] 0 0 1 0
[4,] 0 0 0 0
That is just a typo: you should first pad the vector, and then convert it to a diagonal matrix.
matB <- diag( c(seq_b,0) )
Related
I have a list of locations and their weights (calculated distances apart) in a matrix.
I would like the optimal solution for each location having 3 connections, minimizing total distance.
costs6 <- matrix(c(0,399671,1525211,990914,1689886,1536081,399671,0,1802419,1128519,1964930,1603803,1525211,1802419,0,814942,164677,943489,990914,1128519.4,814942.7,0,953202,565712,1689886,1964930,164677,953202,0, 1004916,1536081,1603803,943489,565712,1004916,0),ncol=6,byrow=TRUE)
plantcap <- rep(3,6)
citydemand <- rep(3,6)
plant.signs <- rep("=",6)
city.signs <- rep("=",6)
lptrans <- lp.transport(costs6,"min",plant.signs,plantcap,city.signs,citydemand)
lptrans$solution
lptrans
This LP solver returns
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 3 0 0 0 0 0
[2,] 0 3 0 0 0 0
[3,] 0 0 3 0 0 0
[4,] 0 0 0 3 0 0
[5,] 0 0 0 0 3 0
[6,] 0 0 0 0 0 3
I am wondering if there is a way to max out any Xij at 1, so that the solver will give me three ones in each column/row, rather than one 3 in each column/row? If not, is there another solver I can use to find the solution?
Something like this, setting it up as an LP problem (assuming a symmetric solution matrix)?
library(lpSolve)
costs6 <- matrix(c(0,399671,1525211,990914,1689886,1536081,
399671,0,1802419,1128519,1964930,1603803,
1525211,1802419,0,814942,164677,943489,
990914,1128519.4,814942.7,0,953202,565712,
1689886,1964930,164677,953202,0, 1004916,
1536081,1603803,943489,565712,1004916,0),ncol=6,byrow=TRUE)
nLoc <- nrow(costs6)
nParams <- sum(1:(nLoc - 1L))
# set up the constraint matrix
# columns are parameters corresponding to the lower triangular of costs6 (by column)
# the first six constraints are for the row/column sums
# the last 15 constraints are for the maximum number of times each path can be used (1)
nConst <- sum(1:nLoc)
mConst <- matrix(0L, nConst, nParams)
mConst[matrix(c(c(combn(1:nLoc, 2)), rep(1:nParams, each = 2)), ncol = 2)] <- 1L
mConst[(nLoc + 1L):nConst,] <- diag(nParams)
lpSol <- lp(
direction = "min",
objective.in = unlist(costs6[lower.tri(costs6)]),
const.mat = mConst,
const.dir = c(rep("=", nLoc), rep("<=", nParams)),
const.rhs = c(rep(3L, nLoc), rep(1L, nParams)),
all.int = TRUE
)
lpSol
#> Success: the objective function is 8688039
# convert the solution to a transport matrix
mSol <- matrix(0, nLoc, nLoc)
mSol[lower.tri(mSol)] <- lpSol$solution
mSol[upper.tri(mSol)] <- t(mSol)[upper.tri(mSol)]
mSol
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 0 1 1 1 0 0
#> [2,] 1 0 0 1 1 0
#> [3,] 1 0 0 0 1 1
#> [4,] 1 1 0 0 0 1
#> [5,] 0 1 1 0 0 1
#> [6,] 0 0 1 1 1 0
How can I create all binary combinations of matrices with the condition that there can only be a single 1 per column and row. The example will clarify. This particular example must have 6 matrices of combinations, I am showing only the first 2.
c1 <- matrix(c(1, 0, 0, 0, 1, 0, 0, 0, 1), nrow = 3) #First combination
c2 <- matrix(c(0, 1, 0, 1, 0, 0, 0, 0, 1), nrow = 3) #Second combination
What you are asking for is equivalent to finding all permutations of length = n where n = nrow(c1) (or c2 above). Using the FUN argument of permuteGeneral from RcppAlgos (I am the author), we can easily generate the desired outcome:
n <- 3L
myIdentity <- diag(nrow = n)
library(RcppAlgos)
permuteGeneral(n, n, FUN = function(x) myIdentity[x, ])
[[1]]
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 1 0
[3,] 0 0 1
[[2]]
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 0 1
[3,] 0 1 0
[[3]]
[,1] [,2] [,3]
[1,] 0 1 0
[2,] 1 0 0
[3,] 0 0 1
[[4]]
[,1] [,2] [,3]
[1,] 0 1 0
[2,] 0 0 1
[3,] 1 0 0
[[5]]
[,1] [,2] [,3]
[1,] 0 0 1
[2,] 1 0 0
[3,] 0 1 0
[[6]]
[,1] [,2] [,3]
[1,] 0 0 1
[2,] 0 1 0
[3,] 1 0 0
There are many other ways of generating the requested output. Most notably, utilizing the tried and true combinat package, we can get a similar result (the output will be in a different order):
combinat::permn(3, fun = function(x) myIdentity[x, ])
Now that we have reduced the problem to simply generating permutations, we can use any of the great packages (arrangements, gtools, multicool, partitions, etc.) for generating permutations to obtain our desired result with the help of lapply:
library(arrangements)
myPerms <- permutations(n)
lapply(1:nrow(myPerms), function(x) myIdentity[myPerms[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))
I am looking for an easier way to do the following:
m <- matrix(0, nrow=3, 3)
v <- c(1, 3, 2)
for (i in 1:nrow(m)) {
m[[i, v[i]]] = 1
}
The above code creates the following index matrix:
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 0 1
[3,] 0 1 0
There surely must be a better way to do this?!
One way to do it without pre-defining the matrix would be to use outer:
num.col <- 3
outer(v, seq_len(num.col), "==") * 1
# [,1] [,2] [,3]
# [1,] 1 0 0
# [2,] 0 0 1
# [3,] 0 1 0
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)
))