i have a 240 X 2 matrix and my aim is to partition it into 40 groups of 6 X 2 matrices and determine the determinants of all the Covariance matrices. i have accomplished the task with this code.
mat=matrix(0,240,2)
m=numeric()
n=0
for ( i in 1:40) {
m[i]=det(cov(mat[(n+1):(n+6),]))
n=n+6
}
Is there a better way to get these determinants of the Covariance matrices and the 40 different Covariance matrices?
1) apply/array Reshape into a 3 dimensional array and use apply:
apply(array(mat, c(6, 40, 2)), 2, function(x) det(cov(x)))
2) rollapply
library(zoo)
rollapply(mat, 6, by = 6, function(x) det(cov(x)), by.column = FALSE)
3) tapply
tapply(1:240, gl(40, 6), function(ix) det(cov(mat[ix, ])))
4) sapply
sapply(seq(1, 240, 6), function(i) det(cov(mat[i + 0:5, ])))
5) for
m <- numeric(40)
for(i in seq(1, 240, 6)) m[i] <- det(cov(mat[i + 0:5, ]))
Related
I am running below code to evaluate a function at each value of r.
For each element of r, the function calculates the sum of elements of a matrix product. Before doing this, values of M are adjusted based on a kernel function.
# (1) set-up with toy data
r <- seq(0, 10, 1)
bw <- 25
M <- matrix(data = c(0, 1, 2,
1, 0, 1,
2, 1, 0), nrow = 3, ncol = 3)
X <- matrix(rep(1, 9), 3, 3)
#
# (2) computation
res <- c()
# loop, calculationg sum, Epanechnikov kernel
for(i in seq_along(r)) {
res[i] <- sum(
# Epanechnikov kernel
ifelse(-bw < (M - r[i]) & (M - r[i]) < bw,
3 * (1 - ((M - r[i])^2 / bw^2)) / (4*bw),
0) * X,
na.rm = TRUE
)
}
# result
res
I am looking for recommendations to speed this up using base R. Thank you!
Using outer:
Mr <- outer(c(M), r, "-")
colSums(3*(1 - Mr^2/bw^2)/4/bw*(abs(Mr) < bw)*c(X))
#> [1] 0.269424 0.269760 0.269232 0.267840 0.265584 0.262464 0.258480 0.253632 0.247920 0.241344 0.233904
I'll also note that the original for loop solution can be sped up by pre-allocating res (e.g., res <- numeric(length(r))) prior to the for loop.
How can I implement a Generalized Assignment Problem: https://en.wikipedia.org/wiki/Generalized_assignment_problem to be solved with Genetic Algorithms https://cran.r-project.org/web/packages/GA/GA.pdf in R.
I have a working example of the code but its not working:
require(GA)
p <- matrix(c(5, 1, 5, 1, 5, 5, 5, 5, 1), nrow = 3)
t <- c(2, 2, 2)
w <- c(2, 2, 2)
assigment <- function(x) {
f <- sum(x * p)
penalty1 <- sum(w)*(sum(t)-sum(w*x))
penalty2 <- sum(w)*(1-sum(x))
f - penalty1 - penalty2
}
GA <- ga(type = "binary", fitness = assigment, nBits = length(p),
maxiter = 1000, run = 200, popSize = 20)
summary(GA)
It seems there are problems in your definition of the fitness function, i.e. the assigment() function.
x is a binary vector, and not a matrix as in the theory, so sum(x * p) is not doing what you likely expect (note that x has length 9 and p is a 3x3 matrix in your example);
the constrain on the sum of x_{ij} is not correctly taken into account by the penalty2 term;
the penalisations should act differently for penalty1 and penalty2, the first is an inequality (i.e. <=) while the second is a strict equality (i.e. =).
w is defined as a vector, but it should be a matrix of the same size as x
I have a list of 40 data sets who all have the same columns. I want to bind the 7th column of each data set. I thought about doing this with a matrix using cbind. This is my code:
RetRates <- function(q) {
q <- matrix(nrow = 766, ncol = length(ListeActions),
data = rep(0, 766), byrow = TRUE)
s <- 0
for (i in 1:length(ListeActions)) {
x <- ListeActions[[i]]
q[,i] <- cbind(q[,i], x[,9]) ## I need the 9th column
}
return(q)
}
Hedi <- matrix(nrow = 766, ncol = length(ListeActions),
data = rep(0, 766), byrow = TRUE)
Hedi <- RetRates(Hedi)
I get these warnings :
Warning messages: 1: In replace(q[, i], 1:766, x[, 9]) : the number
of objects to be replaced is not a multiple of the size of the
replacement !
Let's take a smaller example: cbind the 5th columns of each of these 3 matrices
d1 <- matrix(runif(30), 5, 6)
d2 <- matrix(rnorm(30), 5, 6)
d3 <- matrix(rnorm(30), 5, 6)
First we put the 3 matrices in a list
M <- list(d1=d1, d2=d2, d3=d3)
Then we could use, as in your question, a for loop
res1 <- matrix(NA, nrow=5, ncol=length(M))
for (i in 1:length(M)) {
res1[, i] <- M[[i]][,5]
}
Or we could use some magical R functions to get the result in one slightly more obscure command
res2 <- do.call(cbind, lapply(M, "[",,5))
I have a list of three two-dimensional arrays that contains x, y and z coordinates of some points (to draw a surface from them, I store them in two-dimensional arrays, like surface plots in MATLAB).
Example:
points <- list(x=matrix(c(1, 2, 3, 4), nrow=2),
y=matrix(c(5, 6, 1, 4), nrow=2),
z=matrix(c(1, 9, 2, 3), nrow=2))
This is a representation of points with coordinates (1, 5, 1), (2, 6, 9) and so on (4 points total).
Now I have to multiply every (x, y, z) point with some fixed matrix C (to rotate my surface) and return the result in the same form of list of two-dimensional matrixes.
I can do it in this way with loops:
apply_matrix <- function(C, points) {
x <- points$x
y <- points$y
z <- points$z
n <- nrow(x)
m <- ncol(x)
outx <- matrix(rep(0, n*m), nrow = n)
outy <- matrix(rep(0, n*m), nrow = n)
outz <- matrix(rep(0, n*m), nrow = n)
for (i in 1:nrow(x)) {
for (j in 1:ncol(x)) {
out <- C %*% c(x[i, j], y[i, j], z[i, j])
outx[i,j] <- out[1,]
outy[i,j] <- out[2,]
outz[i,j] <- out[3,]
}
}
list(x=outx,y=outy,z=outz)
}
However, I'm looking for more efficient loop-free solution.
I believe it is possible to convert the list to three-dimensional matrix and then ask R to multiply my matrix C to this three-dimensional matrix using appropriate dimensions, but cannot figure out how to do it.
Here I first convert the list to a three-dimensional array and then also return one:
C <- matrix(rnorm(3 * 3), 3)
ar <- array(unlist(points), c(dim(points[[1]]), 3))
aperm(apply(ar, 1:2, `%*%`, x = t(C)), c(2, 3, 1))
If I have an array A
A <- array(0, c(4, 3, 5))
for(i in 1:5) {
set.seed(i)
A[, , i] <- matrix(rnorm(12), 4, 3)
}
and if I have matrix B
set.seed(6)
B <- matrix(rnorm(12), 4, 3)
The code to subtract B from the each matrix of the array A would be:
d<-array(0, c(4,3,5))
for(i in 1:5){
d[,,i]<-A[,,i]-B
}
However, what would be the code to perform the same calculation using a function from "apply" family?
This is what sweep is for.
sweep(A, 1:2, B)
Maybe not very intuitive:
A[] <- apply(A, 3, `-`, B)
Because you are looping on the last array dimension, you can simply do:
d <- A - as.vector(B)
and it will be much faster. It is the same idea as when you subtract a vector from a matrix: the vector is recycled so it is subtracted to each column.