I have the following logical matrix:-
k <- matrix(c(T,T,F,F,T,F,T,F,T,T,F,F,T,F,T,F,T,T,T,T,F,F,F,F,F), 5)
However, when I do the following:-
z <- as.integer(k)
I get an integer vector rather than an integer matrix:-
[1] 1 1 0 0 1 0 1 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 0
I want it to get a matrix like following:-
k <- matrix(c(1,1,0,0,1,0,1,0,1,1,0,0,1,0,1,0,1,1,1,1,0,0,0,0,0), 5)
Thanks in advance.
Use unary +:
+k
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 0 0 0 0
## [2,] 1 1 0 1 0
## [3,] 0 0 1 1 0
## [4,] 0 1 0 1 0
## [5,] 1 1 1 1 0
We may need to use [] to keep the dim intact
z <- k
z[] <- as.integer(k)
Or another option is to do the dim assignment
z <- as.integer(k)
dim(z) <- dim(k)
Or without doing the dim changes, can just multiply by 1 to coerce to numeric
z <- k * 1
k <- matrix(c(T,T,F,F,T,F,T,F,T,T,F,F,T,F,T,F,T,T,T,T,F,F,F,F,F), 5)
res <- +k
res
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 1 0 0 0 0
#> [2,] 1 1 0 1 0
#> [3,] 0 0 1 1 0
#> [4,] 0 1 0 1 0
#> [5,] 1 1 1 1 0
Created on 2021-10-04 by the reprex package (v2.0.1)
Related
I would like to transform a vector of integer such:
vector = c(0,6,1,8,5,4,2)
length(vector) = 7
max(vector) = 8
into a matrix m of nrow = length(vector) and ncol = max(vector) :
m =
0 0 0 0 0 0 0 0
1 1 1 1 1 1 0 0
1 0 0 0 0 0 0 0
1 1 1 1 1 1 1 1
1 1 1 1 1 0 0 0
1 1 1 1 0 0 0 0
1 1 0 0 0 0 0 0
It's just an example of what I am trying to do. I intend that the function work with every vector of integer.
I tried to used the function mapply(rep, 1, vector) but I obtained a list and I didn't succeed to convert it into a matrix...
It would be very useful for me if someone can help me.
Best Regards,
Maxime
If you use c(rep(1, x), rep(0, max(vector-x)) on each element of your variable vector you get the desired binary results. Looping that with sapply even returns a matrix. You only need to transpose it afterwards and you get your result.
vector = c(0,6,1,8,5,4,2)
result <- t(sapply(vector, function(x) c(rep(1, x), rep(0, max(vector)-x))))
is.matrix(result)
#> [1] TRUE
result
#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
#> [1,] 0 0 0 0 0 0 0 0
#> [2,] 1 1 1 1 1 1 0 0
#> [3,] 1 0 0 0 0 0 0 0
#> [4,] 1 1 1 1 1 1 1 1
#> [5,] 1 1 1 1 1 0 0 0
#> [6,] 1 1 1 1 0 0 0 0
#> [7,] 1 1 0 0 0 0 0 0
Putting that into a function is easy:
binaryMatrix <- function(v) {
t(sapply(v, function(x) c(rep(1, x), rep(0, max(v)-x))))
}
binaryMatrix(vector)
# same result as before
Created on 2021-02-14 by the reprex package (v1.0.0)
Another straightforward approach would be to exploit matrix sub-assignment using row/column indices in a matrix form (see, also, ?Extract).
Define a matrix of 0s:
x = c(0, 6, 1, 8, 5, 4, 2)
m = matrix(0L, nrow = length(x), ncol = max(x))
And fill with 1s:
i = rep(seq_along(x), x) ## row indices of 1s
j = sequence(x) ## column indices of 1s
ij = cbind(i, j)
m[ij] = 1L
m
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
#[1,] 0 0 0 0 0 0 0 0
#[2,] 1 1 1 1 1 1 0 0
#[3,] 1 0 0 0 0 0 0 0
#[4,] 1 1 1 1 1 1 1 1
#[5,] 1 1 1 1 1 0 0 0
#[6,] 1 1 1 1 0 0 0 0
#[7,] 1 1 0 0 0 0 0 0
Assuming that all values in the vector are non-negative integers, you can define the following function
transformVectorToMatrix <- function(v) {
nrOfCols <- max(v)
zeroRow <- integer(nrOfCols)
do.call("rbind",lapply(v,function(nrOfOnes) {
if(nrOfOnes==0) return(zeroRow)
if(nrOfOnes==nrOfCols) return(zeroRow+1)
c(integer(nrOfOnes)+1,integer(nrOfCols-nrOfOnes))
}))
}
and finally do
m = transformVectorToMatrix(vector)
to get your desired binary matrix.
I want to create the following matrix
A <- matrix(0,n,n)
for(i in 1:n){
for(j in 1:n){
if(abs(i - j) == 1) A1[i,j] <- 1
}
}
Is there another way to create such a matrix? I just want to avoid using for-loop.
A simple option is using outer + abs
> +(abs(outer(1:n,1:n,`-`))==1)
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,] 0 1 0 0 0 0 0
[2,] 1 0 1 0 0 0 0
[3,] 0 1 0 1 0 0 0
[4,] 0 0 1 0 1 0 0
[5,] 0 0 0 1 0 1 0
[6,] 0 0 0 0 1 0 1
[7,] 0 0 0 0 0 1 0
where n <- 7
Create a matrix with 0 values
Subtract row index with column index.
Replace values in matrix with 1 where the difference is 1 or -1
n <- 5
A <- matrix(0,n,n)
inds <- row(A) - col(A)
A[abs(inds) == 1] <- 1
A
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 1 0 0 0
#[2,] 1 0 1 0 0
#[3,] 0 1 0 1 0
#[4,] 0 0 1 0 1
#[5,] 0 0 0 1 0
where row(A) - col(A) (inds) returns :
inds
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 -1 -2 -3 -4
#[2,] 1 0 -1 -2 -3
#[3,] 2 1 0 -1 -2
#[4,] 3 2 1 0 -1
#[5,] 4 3 2 1 0
Using tidyverse - crossing to get the combinations of sequence, then
get the absolute difference (-) between the columns, check if it is equal to 1, and reshape from 'long' to 'wide' with pivot_wider
library(dplyr)
library(tidyr)
crossing(n1 = 1:n, n2 = 1:n) %>%
mutate(new = +(abs((n1 - n2)) == 1)) %>%
pivot_wider(names_from = n2, values_from = new)
-output
# A tibble: 5 x 6
# n1 `1` `2` `3` `4` `5`
# <int> <int> <int> <int> <int> <int>
#1 1 0 1 0 0 0
#2 2 1 0 1 0 0
#3 3 0 1 0 1 0
#4 4 0 0 1 0 1
#5 5 0 0 0 1 0
Or another option with diag from base R
+(abs(row(diag(n)) - col(diag(n))) == 1)
-output
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 1 0 0 0
#[2,] 1 0 1 0 0
#[3,] 0 1 0 1 0
#[4,] 0 0 1 0 1
#[5,] 0 0 0 1 0
You can reduce the amount of code by using the function stats::toeplitz, which follows the idea in the answer by Ronak Shah.
f1 <- function(n)
{
A <- matrix(0,n,n)
inds <- row(A) - col(A)
A[abs(inds) == 1] <- 1
A
}
n <- 10
A1 <- f1(n)
A2 <- toeplitz(c(0,1,rep(0,n-2)))
all.equal(A1, A2)
#[1] TRUE
I have a large matrix containing 3D coordinates of points and I want to have the adjacency matrix of them using their delaunay triangulation results. To have their delaunay triangulation values I used 'geometry' package. To have an example of what I have, I prepared the below codes:
values<-rnorm(12,mean = 10, 5)
mat<-matrix(values,ncol = 3)
dimnames(mat)<-list(c("asd","qwe","rty","poi"),c("x","y","z"))
require("geometry")
delaunaynMat<-delaunayn(mat)
However, I could not find any proper function to build the adjacency matrix from delaunay results. Any idea about it?
Perhaps with the DatabionicSwarm package
> library(DatabionicSwarm)
> Delaunay4Points(mat, IsToroid=FALSE)
1 2 3 4
1 0 1 1 1
2 1 0 1 1
3 1 1 0 0
4 1 1 0 0
Or wirh deldir (only for 2D):
> require(deldir)
Loading required package: deldir
deldir 0.1-15
> set.seed(42)
> x <- runif(6)
> y <- runif(6)
> dxy <- deldir(x,y)
> ind <- dxy$dirsgs[,5:6]
> adj <- matrix(0, length(x), length(y))
> for (i in 1:nrow(ind)){
+ adj[ind[i,1], ind[i,2]] <- 1
+ adj[ind[i,2], ind[i,1]] <- 1
+ }
> adj
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 1 0 1 0 0
[2,] 1 0 0 1 1 0
[3,] 0 0 0 0 1 1
[4,] 1 1 0 0 1 1
[5,] 0 1 1 1 0 1
[6,] 0 0 1 1 1 0
EDIT
There's something weird. I need to flip the matrix of Delaauny4Points to get results consistent with deldir:
set.seed(42)
x <- runif(6)
y <- runif(6)
dxy <- deldir(x,y)
ind <- dxy$delsgs[,5:6]
adj <- matrix(0, length(x), length(y))
for (i in 1:nrow(ind)){
adj[ind[i,1], ind[i,2]] <- 1
adj[ind[i,2], ind[i,1]] <- 1
}
adj
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 1 0 1 0 1
[2,] 1 0 1 1 1 0
[3,] 0 1 0 0 1 1
[4,] 1 1 0 0 1 1
[5,] 0 1 1 1 0 1
[6,] 1 0 1 1 1 0
> Delaunay4Points(cbind(x,y), IsToroid=FALSE)[6:1,6:1] # <- look
6 5 4 3 2 1
6 0 1 0 1 0 1
5 1 0 1 1 1 0
4 0 1 0 0 1 1
3 1 1 0 0 1 1
2 0 1 1 1 0 1
1 1 0 1 1 1 0
Consider the 8 by 6 binary matrix, M:
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
The following matrix contains the column index of the 1's in matrix M
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 3 2 5 2 3 2
[2,] 4 3 6 4 4 3
[3,] 7 6 7 5 5 5
[4,] 8 7 8 7 6 8
Let's denote that
ind <- matrix(c(3,4,7,8,
2,3,6,7,
5,6,7,8,
2,4,5,7,
3,4,5,6,
2,3,5,8),nrow = 4, ncol=6)
I'm trying to change a single position of 1 into 0in each column of M.
For an example, one possibility of index of1s in each column would be (4,2,5,4,3,2), i.e. 4th position of Column1, 2nd position of Column2, 5thposition of Column3 and so on. Let N be the resulting matrices. This will produce the following matrix N
N <- matrix(c(0,0,1,0,0,0,1,1,
0,0,1,0,0,1,1,0,
0,0,0,0,0,1,1,1,
0,1,0,0,1,0,1,0,
0,0,0,1,1,1,0,0,
0,0,1,0,1,0,0,1),nrow = 8,ncol = 6)
Here is that N
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 0 0 0
[2,] 0 0 0 1 0 0
[3,] 1 1 0 0 0 1
[4,] 0 0 0 0 1 0
[5,] 0 0 0 1 1 1
[6,] 0 1 1 0 1 0
[7,] 1 1 1 1 0 0
[8,] 1 0 1 0 0 1
For EACH of the resulting matrices of N, I do the following calculations.
X <- cbind(c(rep(1,nrow(N))),N)
ans <- sum(diag(solve(t(X)%*%X)[-1,-1]))
Then, I want to obtain the matrix N, which produce the smallest value of ans. How do I do this efficiently?
Let me know if this works.
We first build a conversion function that I'll need, and we build also the reverse function as you may need it at some point:
ind_to_M <- function(ind){
M <- matrix(rep(0,6*8),ncol=6)
for(i in 1:ncol(ind)){M[ind[,i],i] <- 1}
return(M)
}
M_to_ind <- function(M){apply(M==1,2,which)}
Then we will build a matrix of possible ways to ditch a value
all_possible_ways_to_ditch_value <- 1:4
for (i in 2:ncol(M)){
all_possible_ways_to_ditch_value <- merge(all_possible_ways_to_ditch_value,1:4,by=NULL)
}
# there's probably a more elegant way to do that
head(all_possible_ways_to_ditch_value)
# x y.x y.y y.x y.y y
# 1 1 1 1 1 1 1 # will be used to ditch the 1st value of ind for every column
# 2 2 1 1 1 1 1
# 3 3 1 1 1 1 1
# 4 4 1 1 1 1 1
# 5 1 2 1 1 1 1
# 6 2 2 1 1 1 1
Then we iterate through those, each time storing ans and N (as data is quite small overall).
ans_list <- list()
N_list <- list()
for(j in 1:nrow(all_possible_ways_to_ditch_value)){
#print(j)
ind_N <- matrix(rep(0,6*3),ncol=6) # initiate ind_N as an empty matrix
for(i in 1:ncol(M)){
ind_N[,i] <- ind[-all_possible_ways_to_ditch_value[j,i],i] # fill with ind except for the value we ditch
}
N <- ind_to_M(ind_N)
X <- cbind(c(rep(1,nrow(N))),N)
ans_list[[j]] <- try(sum(diag(solve(t(X)%*%X)[-1,-1])),silent=TRUE) # some systems are not well defined, we'll just ignore the errors
N_list[[j]] <- N
}
We finally retrieve the minimal ans and the relevant N
ans <- ans_list[[which.min(ans_list)]]
# [1] -3.60288e+15
N <- N_list[[which.min(ans_list)]]
# [,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 0 0
# [7,] 1 0 1 0 0 0
# [8,] 0 0 0 0 0 0
EDIT:
To get minimal positive ans
ans_list[which(!sapply(ans_list,is.numeric))] <- Inf
ans <- ans_list[[which.min(abs(unlist(ans_list)))]]
# [1] 3.3
N <- N_list[[which.min(abs(unlist(ans_list)))]]
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 0 0 0 0 0 0
# [2,] 0 1 0 1 0 0
# [3,] 1 1 0 0 0 1
# [4,] 1 0 0 0 1 0
# [5,] 0 0 0 1 1 1
# [6,] 0 1 1 0 1 0
# [7,] 1 0 1 1 0 0
# [8,] 0 0 1 0 0 1
EDIT 2 : to generalize the number of rows of ind to ditch
It seems to give the same result for ans for n_ditch = 1, and results make sense for n_ditch = 2
n_ditch <- 2
ditch_possibilities <- combn(1:4,n_ditch) # these are all the possible sets of indices to ditch for one given columns
all_possible_ways_to_ditch_value <- 1:ncol(ditch_possibilities) # this will be all the possible sets of indices of ditch_possibilities to test
for (i in 2:ncol(M)){
all_possible_ways_to_ditch_value <- merge(all_possible_ways_to_ditch_value,1:ncol(ditch_possibilities),by=NULL)
}
ans_list <- list()
N_list <- list()
for(j in 1:nrow(all_possible_ways_to_ditch_value)){
#print(j)
ind_N <- matrix(rep(0,6*(4-n_ditch)),ncol=6) # initiate ind_N as an empty matrix
for(i in 1:ncol(M)){
ind_N[,i] <- ind[-ditch_possibilities[,all_possible_ways_to_ditch_value[j,i]],i] # fill with ind except for the value we ditch
}
N <- ind_to_M(ind_N)
X <- cbind(c(rep(1,nrow(N))),N)
ans_list[[j]] <- try(sum(diag(solve(t(X)%*%X)[-1,-1])),silent=TRUE) # some systems are not well defined, we'll just ignore the errors
N_list[[j]] <- N
}
Suppose I have a set N={1,2,3}, then we can list all its 7 non-empty subsets.
n=3 # number of elements in a set
a=2^n-1 # number of non-empty subsets for that set
subsets=lapply(1:n, function(x) combn(n, x)) # list all the non-empty subest
subsets
Now I want to put these subsets into a matrix and organized like:
if n=3 or in an index matrix:
1 0 0 1 0 0
0 2 0 0 1 0
0 0 3 0 0 1
1 2 0 1 1 0
1 0 3 1 0 1
0 2 3 0 1 1
1 2 3 1 1 1
Anyone knows how to write the code that could be easily extended to any n (=4, 5, 6...)? I tried this:
subindex=matrix(c(0), nrow=a, ncol=n)
i=1
while(i<=a){
j=n
b=2^(n-1)
N=i
while(N>0){
if(b<=N) {subindex[i,j]=1}&{N=N-b}
b=trunc(b/2)
j=j-1
}
i=i+1
}
subindex
But the index matrix I get is wrong in row 3 and 4. If n=4, then there are more errors... Can anybody correct this or simplify this code? or just write a completely new code. Really appreciate.
n <- 4
lapply(seq_len(n), function(i)t(combn(n, i, FUN = tabulate, nbins = n)))
# [[1]]
# [,1] [,2] [,3] [,4]
# [1,] 1 0 0 0
# [2,] 0 1 0 0
# [3,] 0 0 1 0
# [4,] 0 0 0 1
#
# [[2]]
# [,1] [,2] [,3] [,4]
# [1,] 1 1 0 0
# [2,] 1 0 1 0
# [3,] 1 0 0 1
# [4,] 0 1 1 0
# [5,] 0 1 0 1
# [6,] 0 0 1 1
#
# [[3]]
# [,1] [,2] [,3] [,4]
# [1,] 1 1 1 0
# [2,] 1 1 0 1
# [3,] 1 0 1 1
# [4,] 0 1 1 1
#
# [[4]]
# [,1] [,2] [,3] [,4]
# [1,] 1 1 1 1