Say I have three lists:
l_zero
[[1]]
[,1] [,2]
[1,] 0 0
[2,] 0 0
[[2]]
[,1] [,2]
[1,] 0 0
[2,] 0 0
l_ind <- list(matrix(c(1,1), ncol = 2), matrix(c(1,1,1,2), ncol = 2))
l_ind
[[1]]
[,1] [,2]
[1,] 1 1
[[2]]
[,1] [,2]
[1,] 1 1
[2,] 1 2
l_val <- list(5, c(4, 7))
l_val
[[1]]
[1] 5
[[2]]
[1] 4 7
I would like to run Map over the three lists with the goal of replacing in l_zero the zeros with the coordinates in l_ind with the values from l_val.
My attempt gives me the following:
Map(function(l_zero, l_ind, l_val) l_zero[l_ind] <- l_val, l_zero = l_zero, l_ind = l_ind, l_val = l_val)
[[1]]
[1] 5
[[2]]
[1] 4 7
As you can see, the original dimensions of the matrices are reduced, but I would like to keep the dimensions of the matrices and just replace the values with the coordinates in l_ind. I tried l_zero[l_ind, drop = FALSE], but that didn't help either.
Can someone help me with this?
Here's a bit simpler method, The [<- replacement function can be used in Map()'s function argument. It takes three arguments, in order.
Map("[<-", l_zero, l_ind, l_val)
# [[1]]
# [,1] [,2]
# [1,] 5 0
# [2,] 0 0
#
# [[2]]
# [,1] [,2]
# [1,] 4 7
# [2,] 0 0
You need to return the modified value from your mapped function (see return(l_zero) below).
l_zero <- replicate(2,matrix(0,2,2),simplify=FALSE)
l_ind <- list(matrix(c(1,1), ncol = 2), matrix(c(1,1,1,2), ncol = 2))
l_val <- list(5, c(4, 7))
ff <- function(l_zero, l_ind, l_val) {
l_zero[l_ind] <- l_val
return(l_zero)
}
Map(ff, l_zero = l_zero, l_ind = l_ind, l_val = l_val)
Results:
## [[1]]
## [,1] [,2]
## [1,] 5 0
## [2,] 0 0
##
## [[2]]
## [,1] [,2]
## [1,] 4 7
## [2,] 0 0
Related
For example I have a 2*3 matrix
[,1] [,2] [,3]
[1,] 2 4 6
[2,] 3 5 7
I want to have a 3*3 matrix inserting 1 in the diagonal In R
The output :
[,1] [,2] [,3]
[1,] 1 4 6
[2,] 2 1 7
[3,] 3 5 1
One option could be:
mat_new <- `diag<-`(matrix(ncol = ncol(mat), nrow = nrow(mat) + 1, 0), 1)
mat_new[mat_new == 0] <- mat
[,1] [,2] [,3]
[1,] 1 4 6
[2,] 2 1 7
[3,] 3 5 1
Or a variation on the original idea (proposed by #Henrik):
mat_new <- diag(ncol(mat))
mat_new[mat_new == 0] <- mat
Sample data:
mat <- structure(2:7, .Dim = 2:3, .Dimnames = list(c("[1,]", "[2,]"),
NULL))
Using append.
unname(mapply(function(x, y) append(x, 1, y), as.data.frame(m), 1:ncol(m) - 1))
# [,1] [,2] [,3]
# [1,] 1 4 6
# [2,] 2 1 7
# [3,] 3 5 1
Or using replace.
replace(diag(3), diag(3) < 1, m)
# [,1] [,2] [,3]
# [1,] 1 4 6
# [2,] 2 1 7
# [3,] 3 5 1
Data:
m <- structure(2:7, .Dim = 2:3)
In the case of your matrix you could play around upper and lower matrices. I include a code that could be useful:
#Input matrix
A <- matrix(c(2,4,6,3,5,7),nrow = 2,ncol = 3,byrow = T)
[,1] [,2] [,3]
[1,] 2 4 6
[2,] 3 5 7
#Output matrix
B <- matrix(0,nrow = 3,ncol = 3)
[,1] [,2] [,3]
[1,] 0 0 0
[2,] 0 0 0
[3,] 0 0 0
Now we replace:
#Replace
B[upper.tri(B)] <- A[upper.tri(A)]
B[lower.tri(B)] <- A[lower.tri(A,diag = T)]
diag(B) <- 1
#Final output
B
The result:
[,1] [,2] [,3]
[1,] 1 4 6
[2,] 2 1 7
[3,] 3 5 1
I just benchmark the functions given from previous answerers:
add_diagonal <- function(mat) {
res <- diag(ncol(mat))
res[res == 0] <- mat
}
add_diagonal_1 <- function(mat) {
n <- max(dim(mat))
res <- matrix(0, nrow=n, ncol=n)
res[upper.tri(res)] <- mat[upper.tri(mat)]
res[lower.tri(res)] <- mat[lower.tri(mat)]
diag(res) <- 1
res
}
add_diagonal_2 <- function(mat) {
n <- max(dim(mat))
replace(diag(n), diag(n) < 1, mat)
}
add_diagonal_3 <- function(mat) {
unname(mapply(function(x, y) append(x, 1, y), as.data.frame(mat), 1:ncol(mat) - 1))
}
require(microbenchmark)
A <- matrix(c(2,4,6,3,5,7),nrow = 2,ncol = 3,byrow = T)
microbenchmark(add_diagonal(A), add_diagonal_1(A), add_diagonal_2(A), add_diagonal_3(A), times=10000)
The result:
Unit: microseconds
expr min lq mean median uq max neval
add_diagonal(A) 8.569 10.3865 13.17156 11.8440 14.4760 5256.301 10000
add_diagonal_1(A) 40.601 44.2130 51.68039 48.7940 51.7795 11519.797 10000
add_diagonal_2(A) 14.279 16.8790 20.60770 18.8860 21.7520 5966.649 10000
add_diagonal_3(A) 166.582 173.1480 189.50570 175.8495 179.2100 8586.079 10000
cld
a
c
b
d
As we see, the first function is the fastest, followed by the replace method.
As often, the apply functions are quite bad in performance.
Here is another base R option using diag + expand.grid + replace
replace(
diag(ncol(mat)),
as.matrix(subset(do.call(expand.grid, replicate(2, 1:ncol(mat), simplify = FALSE)), Var1 != Var2)),
mat
)
which gives
[,1] [,2] [,3]
[1,] 1 4 6
[2,] 2 1 7
[3,] 3 5 1
I found this code to resolve a linear equation system with b=0, but I would like to know why with the first matrix only one column is returned and with the second matrix two columns are returned.
library(MASS)
Null(t(A))
R > (A <- matrix(c(1,2,3,2,4,7), ncol = 3, byrow = TRUE))
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 2 4 7
R > Null(t(A))
[,1]
[1,] -8.944272e-01
[2,] 4.472136e-01
[3,] 7.771561e-16
R > (A <- matrix(c(1,2,3,2,4,6), ncol = 3, byrow = TRUE))
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 2 4 6
R > Null(t(A))
[,1] [,2]
[1,] -0.5345225 -0.8017837
[2,] 0.7745419 -0.3381871
[3,] -0.3381871 0.4927193
library(MASS)
A <- matrix(c(1,2,3,2,4,7), ncol = 3, byrow = T)
t(A)
#> [,1] [,2]
#> [1,] 1 2
#> [2,] 2 4
#> [3,] 3 7
B <- matrix(c(1,2,3,2,4,6), ncol = 3, byrow = T)
t(B)
#> [,1] [,2]
#> [1,] 1 2
#> [2,] 2 4
#> [3,] 3 6
From the above, you can see that in your last case, all the rows are linearly combination of one another. In your 1st case, 2 rows are linear combinations.
You have a rank of 2 vs 1 and thus answers of 2 vs 1.
I have a list of matrices.
(below is a simplified example, I actually have a list of 3 matrices, the first one being in 2D, while the second and third ones are in 3D)
> a <- matrix(-1:2, ncol = 2)
> b <- array(c(-2:5), dim=c(2, 2, 2))
> c_list <- list(a,b)
> c_list
[[1]]
[,1] [,2]
[1,] -1 1
[2,] 0 2
[[2]]
, , 1
[,1] [,2]
[1,] -2 0
[2,] -1 1
, , 2
[,1] [,2]
[1,] 2 4
[2,] 3 5
I'd like to apply the function max(0,c_list) to each and every element (without a loop), in order to have the same type of object as "c_list" but with the negative values replaced by zeros.
> output
[[1]]
[,1] [,2]
[1,] 0 1
[2,] 0 2
[[2]]
, , 1
[,1] [,2]
[1,] 0 0
[2,] 0 1
, , 2
[,1] [,2]
[1,] 2 4
[2,] 3 5
I've managed to do it for a matrice or for a list with mapply or lapply, but not for a list of matrices.
Answer : either Sotos' answer
output <- lapply(c_list, function(i)replace(i, i < 0, 0))
or Moody_Mudskipper's answer
output <- lapply(c_list,pmax,0)
You can use pmax, it will preserve the format of the source matrix and vectorized so faster than looping with max.
lapply(c_list,pmax,0)
Using apply and lapply:
a <- matrix(-1:2, ncol = 2)
b <- matrix(-3:0, ncol = 2)
c <- list(a,b)
d <- lapply(c, function(m) {
apply(m, c(1, 2), function(x) max(0, x))
})
Output:
> d
[[1]]
[,1] [,2]
[1,] 0 1
[2,] 0 2
[[2]]
[,1] [,2]
[1,] 0 0
[2,] 0 0
I'm doing some kind of optical character recognition and face the following issue. I store the glyphs in a list of binary matrices and they can be of different size, but their maximum possible width is wid = 3 columns (may be any defined constant, not just 3). In some cases after the first stage of processing I get data which look like this:
myll <- list(matrix(c(0, 0, 0, 1, 1, 0), ncol = 2),
matrix(c(0), ncol = 1),
matrix(c(1, 1, 0), ncol = 3),
matrix(c(1, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1), ncol = 7),
matrix(c(1, 1, 1, 1), ncol = 2))
# [[1]]
# [,1] [,2]
# [1,] 0 1
# [2,] 0 1
# [3,] 0 0
#
# [[2]]
# [,1]
# [1,] 0
#
# [[3]]
# [,1] [,2] [,3]
# [1,] 1 1 0
#
# [[4]]
# [,1] [,2] [,3] [,4] [,5] [,6] [,7]
# [1,] 1 1 1 0 0 0 1
# [2,] 0 1 0 1 0 0 1
# [3,] 1 1 1 1 0 0 1
#
# [[5]]
# [,1] [,2]
# [1,] 1 1
# [2,] 1 1
So, some glyphs may be not separated for some reasons. This happens only with glyphs of maximum possible width. Moreover, there may be some junk at the end of the matrix. I have to split them into matrices of width ncol = wid leaving the last piece (junk) as is. Then I store this matrices in separate elements of list to get the following output:
# [[1]]
# [,1] [,2]
# [1,] 0 1
# [2,] 0 1
# [3,] 0 0
#
# [[2]]
# [,1]
# [1,] 0
#
# [[3]]
# [,1] [,2] [,3]
# [1,] 1 1 0
#
# [[4]]
# [,1] [,2] [,3]
# [1,] 1 1 1
# [2,] 0 1 0
# [3,] 1 1 1
#
# [[5]]
# [,1] [,2] [,3]
# [1,] 0 0 0
# [2,] 1 0 0
# [3,] 1 0 0
#
# [[6]]
# [,1]
# [1,] 1
# [2,] 1
# [3,] 1
#
# [[7]]
# [,1] [,2]
# [1,] 1 1
# [2,] 1 1
At the moment I can make it with the help of this functions
checkGlyphs <- function(gl_m, wid = 3) {
if (ncol(gl_m) > wid)
return(list(gl_m[,1:wid], matrix(gl_m[,-(1:wid)], nrow = nrow(gl_m)))) else
return(gl_m)
}
separateGlyphs <- function(myll, wid = 3) {
require("magrittr")
presplit <- lapply(myll, checkGlyphs, wid)
total_new_length <-
presplit[unlist(lapply(presplit, is.list))] %>% lapply(length) %>% unlist() %>% sum() +
as.integer(!unlist(lapply(presplit, is.list))) %>% sum()
splitted <- vector("list", length = total_new_length)
spl_index <- 1
for (i in 1:length(presplit))
{
if (!is.list(presplit[[i]]))
{
splitted[[spl_index]] <- presplit[[i]]
spl_index <- spl_index + 1
} else
{
for (j in 1:length(presplit[[i]]))
{
splitted[[spl_index]] <- presplit[[i]][[j]]
spl_index <- spl_index + 1
}
}
}
if (any(lapply(splitted, ncol) > wid)) return(separateGlyphs(splitted, wid)) else
return(splitted)
}
But I believe there is more fast and convenient way to achieve the same result (without using for loops and this enlooped reassignment of elements and then recursion if needed O_o).
I will be thankful for any suggestions on the point or, alternatively, for recommending some OCR-packages for R.
This should do the trick, with the values in final being what you're after.
combined <- do.call(cbind, lapply(myll, unlist))
idx <- seq(1, ncol(combined), 2)
final <- do.call(list, lapply(idx, function(x) combined[, x:(x+1)]))
I'm looking for a (build-in) function, which efficiently returns the list of building blocks of a block-diagonal matrix in the following way (rather than iterating over the slots to get the list manually):
#construct bdiag-matrix
library("Matrix")
listElems <- list(matrix(1:4,ncol=2,nrow=2),matrix(5:8,ncol=2,nrow=2))
mat <- bdiag(listElems)
#get back the list
res <- theFunctionImLookingFor(mat)
The result res yields the building blocks:
[[1]]
[,1] [,2]
[1,] 1 3
[2,] 2 4
[[2]]
[,1] [,2]
[1,] 5 7
[2,] 6 8
Edit: Regarding my use case, the list elements in listElems are square and symmetric matrices. If the block is a diagonal matrix, theFunctionImLookingFor should return a list element for each diagonal element.
However, the function should be able to deal with building block matrices like
[,1] [,2] [,3]
[1,] 1 1 0
[2,] 1 1 1
[3,] 0 1 1
or
[,1] [,2] [,3]
[1,] 1 0 1
[2,] 0 1 1
[3,] 1 1 1
i.e. deal with zeros in blocks, which are not diagonal matrices.
I hope this will work for all your cases, the test at the bottom includes a block that contains zeroes.
theFunctionImLookingFor <- function(mat, plot.graph = FALSE) {
stopifnot(nrow(mat) == ncol(mat))
x <- mat
diag(x) <- 1
edges <- as.matrix(summary(x)[c("i", "j")])
library(igraph)
g <- graph.edgelist(edges, directed = FALSE)
if (plot.graph) plot(g)
groups <- unique(Map(sort, neighborhood(g, nrow(mat))))
sub.Mat <- Map(`[`, list(mat), groups, groups, drop = FALSE)
sub.mat <- Map(as.matrix, sub.Mat)
return(sub.mat)
}
listElems <- list(matrix(1:4,ncol=2,nrow=2),
matrix(5:8,ncol=2,nrow=2),
matrix(c(0, 1, 0, 0, 0, 1, 0, 0, 1),ncol=3,nrow=3),
matrix(1:1,ncol=1, nrow=1))
mat <- bdiag(listElems)
theFunctionImLookingFor(mat, plot.graph = TRUE)
# [[1]]
# [,1] [,2]
# [1,] 1 3
# [2,] 2 4
# [[2]]
# [,1] [,2]
# [1,] 5 7
# [2,] 6 8
# [[3]]
# [,1] [,2] [,3]
# [1,] 0 0 0
# [2,] 1 0 0
# [3,] 0 1 1
# [[4]]
# [,1]
# [1,] 1