I have a simple question, but couldn't figure out a good solution. So hope, somebody can help :)
I want to add each column of a matrix B to a column of a matrix A, where an index vector specifies, to which column of A this column should be added to. So it is possible that more than one column of B is added to the same column of A. I want to accumulate these changes and not replace these.
This is a working solution with a for loop:
A <- matrix(0, ncol = 4, nrow = 4)
B <- matrix(c(1, 0, 0, 0, 2, 0, 1, 2, 0, 1, 1, 0), ncol = 3)
cols <- c(1, 2, 2)
for (i in seq_len(ncol(B))) {
A[, cols[i]] <- A[, cols[i]] + B[, i]
}
print(A)
I thought I could write this without a for loop using
A <- matrix(0, ncol = 4, nrow = 4)
B <- matrix(c(1, 0, 0, 0, 2, 0, 1, 2, 0, 1, 1, 0), ncol = 3)
cols <- c(1, 2, 2)
A[, cols] <- A[, cols] + B
print(A)
But this doesn't return the same matrix, because it adds the second column of B to the second column of A but then in the next step replaces this with the third column of B instead of adding both of the replacements together.
I'm looking for a fast and general solution, which works also for different index vectors and matrices.
This doesn't eliminate the loop, but it does make it shorter:
A <- matrix(0, ncol = 4, nrow = 4)
B <- matrix(c(1, 0, 0, 0, 2, 0, 1, 2, 0, 1, 1, 0), ncol = 3)
cols <- c(1, 2, 2)
for(i in unique(cols)){
A[, i] <- A[, i] + apply(as.matrix(B[, cols == i]), 1, sum)
}
print(A)
Try this
ans = A[,cols] + B
ans = sapply(split(1:NCOL(ans), cols), function(i) rowSums(ans[, i, drop = FALSE]))
inds = cbind(rep(1:NROW(A), length(unique(cols))), rep(unique(cols), each = NROW(A)))
replace(A, inds, ans[inds])
# [,1] [,2] [,3] [,4]
#[1,] 1 2 0 0
#[2,] 0 1 0 0
#[3,] 0 2 0 0
#[4,] 0 2 0 0
Related
I have a matrix
A <- matrix(1:16, nrow = 4, ncol = 4, Byrow = FALSE)
I want a row-wise difference of matrix A. That is take element-wise difference between the first and second rows of A, element-wise difference between the second and third rows of A, etc. Since A ∈ R4×4, the resulting matrix should contain row-wise differences which has a dimension of 3 × 4.
Instead of using for-loop to iterate over the rows of A and take differences between consecutive rows, I would like to use the discrete difference operator to speed up the operation. I use sapply() to construct this matrix difference operator B. Then use B × A to compute the row-wise difference.
Let's say Matrix B ∈ R3×4
B <- matrix(c( -1, 1, 0, 0,
0, -1, 1, 0,
0, 0, -1, 1), nrow = 3, ncol = 4, byrow = TRUE)
Expected output be a matrix C ∈ R3×4 with all 1's.
Result_C <- matrix(c( 1, 1, 1, 1,
1, 1, 1, 1,
1, 1, 1, 1), nrow = 3, ncol = 4, byrow = TRUE)
How should I proceed? and what is difference operator for a Matrix in R?
We can use diff to calculate the difference between the rows
diff(A)
# [,1] [,2] [,3] [,4]
#[1,] 1 1 1 1
#[2,] 1 1 1 1
#[3,] 1 1 1 1
You can adress to full columns or rows of the matrix
A <- matrix(1:16, nrow = 4, ncol = 4)
A[2:(nrow(A)),]-A[1:(nrow(A)-1),]
and yes, diff(A) should do the same here
Say I have a tibble with two columns: a group variable (grp) and a list-column
containing matrices of equal dimension (mat).
mat1 <- matrix(c(2, 0, 0, 0), nrow = 2)
mat2 <- matrix(c(0, 0, 0, 0), nrow = 2)
mat3 <- matrix(c(0, 0, 0, 2), nrow = 2)
mat4 <- matrix(c(0, 0, 0, 0), nrow = 2)
df <- tibble(grp = c('a', 'a', 'b', 'b'),
mat = list(mat1, mat2, mat3, mat4))
Edit:
I want to calculate the mean matrix by group, and add it as a new list-column. I.e. The new column should be:
list(matrix(c(1, 0, 0, 0), nrow = 2),
matrix(c(1, 0, 0, 0), nrow = 2),
matrix(c(0, 0, 0, 1), nrow = 2),
matrix(c(0, 0, 0, 1), nrow = 2))
The best I can do is:
df_out <- df %>%
group_by(grp) %>%
mutate(n = n(),
mean_mat = list(Reduce('+', mat) / n)) %>%
ungroup()
It works, but I'm trying to understand why the call to list is necessary, and also hoping to find an alternative approach (either tidyverse or base R) that is perhaps simpler.
I built my own function like this:
library(VineCopula)
Matrix <- c(5, 2, 3, 1, 4,
0, 2, 3, 4, 1,
0, 0, 3, 4, 1,
0, 0, 0, 4, 1,
0, 0, 0, 0, 1)
Matrix <- matrix(Matrix, 5, 5)
family <-par <- par2 <- list()
for(i in 1:3){
# define R-vine pair-copula family matrix
family[[i]] <- c(0, 1, 3, 4, 4,
0, 0, 3, 4, 1,
0, 0, 0, 4, 1,
0, 0, 0, 0, 3,
0, 0, 0, 0, 0)
family[[i]] <- matrix(family[[i]], 5, 5)
# define R-vine pair-copula parameter matrix
par[[i]] <- c(0, 0.2, 0.9, 1.5, 3.9,
0, 0, 1.1, 1.6, 0.9,
0, 0, 0, 1.9, 0.5,
0, 0, 0, 0, 4.8,
0, 0, 0, 0, 0)
par[[i]] <- matrix(par[[i]], 5, 5)
# define second R-vine pair-copula parameter matrix
par2[[i]] <- matrix(0, 5, 5)
}
my_func <- function(Matrix, family, par, par2){
x <- list()
for(i in 1:3){
x[[i]] <- RVineMatrix(Matrix = Matrix,family=family[[i]],par=par[[i]],par2 = par2[[i]])
}
x
}
This will return me a list. How can I then extract specific element from my function. For example, how I can get my_func$Matrix or my_func$par[1]
Note: family <– par <– par2 <– list(). I also tried return(x[i]$family[i]) and return NULL.
To run the function:
y <- my_func(Matrix = Matrix,family = family,par = par,par2 = par2)
> y$Matrix
NULL
Your function's return value is a listof class RVineMatrix with an element named Matrix. See the help page ?RVineMatrix, section Value. So you need y[[1]]$Matrix.
y <- my_func(Matrix, family, par, par2)
class(y)
[1] "list"
class(y[[1]])
[1] "RVineMatrix"
y[[1]]$Matrix
[,1] [,2] [,3] [,4] [,5]
[1,] 5 0 0 0 0
[2,] 2 2 0 0 0
[3,] 3 3 3 0 0
[4,] 1 4 4 4 0
[5,] 4 1 1 1 1
You'll need to assign the outcome of that function to something. For example:
y <- my_func(Matrix = ... , family = ..., par = ..., par2 = ...)
where ... above are the values of your arguments. Based on your my_func definition, the end result is an unnamed list so to access its elements you use:
y[[1]]
y[[2]]
y[[3]]
or just y to access all elements.
If I start with vector1, and test to see which items equal 1:
vector1 <- c(0, 1, 1, 1, 0, 1, 1, 1, 0, 1)
test <- which(vector1 == 1)
test now equals: 2, 3, 4, 6, 7, 8, 10
then, I want to randomly choose two of the items in test:
sample_vector <- sample(test, 2, replace = FALSE)
the above code generated a sample_vector: 6, 3
My question is how do I take sample_vector and turn it into:
vector2 <- 0, 0, 1, 0, 0, 1, 0, 0, 0, 0
I'm essentially looking to assign only the items in sample_vector to equal 1, and the remaining items from vector1 are assigned to equal 0 (i.e. so it looks like vector2). vector2 needs to have the same length at vector1 (10 items).
Thanks!
vector2 <- rep(0, length(vector1))
vector2[sample_vector] <- 1
set.seed(44)
vector1 <- c(0, 1, 1, 1, 0, 1, 1, 1, 0, 1)
test <- which(vector1 == 1)
sample_vector <- sample(test, 2, replace = FALSE)
sample_vector
#[1] 8 3
replace(tabulate(seq_along(vector1)) - 1, sample_vector, 1)
#[1] 0 0 1 0 0 0 0 1 0 0
Use this code.
vector2 <- rep(0,len(vector1))
vector2[sample_vector] = 1
Looking for sensible code to solve the following problem without a stack of "if" comparisons:
dput(acell)
structure(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0), .Dim = c(5L, 5L))
dput(bcell)
structure(c(0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0,
1, 0, 1, 0, 0, 0, 0, 1), .Dim = c(5L, 5L))
It's guaranteed by construction (elsewhere in my code) that there is at least one nonzero entry in bcell in the four locations left,right,up,down one cell from the location of the nonzero value ([2,3]) in acell . Is there some better way to return the indices of all such nonzero cells? I'm currently using (pseudocode), for coords i,j referring to the nonzero element of acell ,
if( bcell[i-1,j]>0 ) found_values<-rbind(found_values,c(i-1,j))
if (bcell[i+1,j]>0 ) found_values<-rbind(found_values,c(i+1,j))
and so on.
Another possibility
# index of non-zero in acell
id <- which(acell == 1, arr.ind = TRUE)
# index of neighbors
rows <- id[1] + c(0, 0, -1, 1)
cols <- id[2] + c(-1, 1, 0, 0)
idx <- cbind(rows, cols)
# values of neighbors in bcell
vals <- bcell[idx]
# index of non-zero neighbors
idx[vals != 0, ]
# rows cols
# [1,] 2 2
# [2,] 3 3
Update: An alternative
# index of non-zero in acell
id <- which(acell == 1, arr.ind = TRUE)
id
# create a matrix with cells adjacent to 'id'
# 'non-neighbor' cells are multiplied by zero
m <- matrix(c(0, 1, 0,
1, 0, 1,
0, 1, 0), ncol = 3) *
bcell[id[1] + (-1:1), id[2] + (-1:1)]
# index of non-zero neighbours
idx <- which(m != 0, arr.ind = TRUE)
# 'de-center' the centered indices
idx2 <- sapply(1:2, function(x) id[x] + (idx[ , x] - 2))
colnames(idx2) <- c("rows", "cols")
idx2
# rows cols
# [1,] 2 2
# [2,] 3 3
Here is a start:
dim <- dim(acell)
lookfor <- which(acell != 0)
lookup <- which(bcell != 0)
if (!((lookfor %% dim[1]) %in% c(1L,0L)) &
!((lookfor %% dim[2]) %in% c(1L,0L)) ) {
neighborsR <- lookup[abs(lookfor-lookup) == 1L]
neighborsC <- lookup[(lookfor %% dim[1] == lookup %% dim[1]) &
abs(lookfor %/% dim[1] - lookup %/% dim[1]) == 1L]
}
neighbors <- c(neighborsR, neighborsC)
res <- cbind(neighbors %% dim[1], neighbors %/% dim[1]+1)
colnames(res) <- c("row", "col")
# row col
#[1,] 3 3
#[2,] 2 2
This can only handle one lookfor value, which is not in the first/last row/column.
neighbors <- function(mat) {
nr <- nrow(mat)
nc <- ncol(mat)
ones <- which(mat == 1)
adjacent <- c(
Filter(function(x) x %% nr != 0, ones - 1) ## above
, Filter(function(x) x %% nr != 1, ones + 1) ## below
, ones - nr ## left
, ones + nr ## right
)
adjacent <- unique(Filter(function(x) x > 0 && x <= nr * nc, adjacent))
out <- matrix(FALSE, nr, nc)
out[adjacent] <- TRUE
out
}
which(neighbors(acell) & bcell, arr.ind = TRUE)
## rows cols
## [1,] 2 2
## [2,] 3 3