In order to produce the matrix in the picture, I tried to write a function code to do this, but I cannot figure it out what to do next, and also not sure if what I already did is right or not.
Matrix <- function(n){
mat1 <- diag(x = ((1:n)-1)/((1:n)+1), n, n)[-1,]
mat2 <- diag(x = ((1:n)-(1:n)+1)/((1:n)+1), n, n)[,-1]
mat3 <- diag(x = 1/((1:n)+1), n, n)
}
An option:
library(SoDA)
n <- 4
triDiag(diagonal = rep(1/(n+1), n+1),
upper = (n:1)/(n+1),
lower = (1:n)/(n+1))
# [,1] [,2] [,3] [,4] [,5]
# [1,] 0.2 0.8 0.0 0.0 0.0
# [2,] 0.2 0.2 0.6 0.0 0.0
# [3,] 0.0 0.4 0.2 0.4 0.0
# [4,] 0.0 0.0 0.6 0.2 0.2
# [5,] 0.0 0.0 0.0 0.8 0.2
It is not entirely clear what you are trying to achieve.
From your description the matrix will have n+1 elements (from 1/(n+1) to n/(n+1)), and I assume the remaining matrix is Sparse. It is not a simple structure to achieve via vectorized computations, but it can be achieved in a single for loop, thus being constructed in O(n) time, given a matrix of size n+1.
In the code below i present an example of such code. The idea is to traverse the matrix in opposite, and only assign 1 type value to each.
Create_Matrix <- function(n){
n1 = n + 1 #Last row, avoid n computations
n2 = n1 + 1
output <- diag(1/n1, nrow = n1, ncol = n1)
for(i in seq(n)){
output[i + 1, i] = output[n1 - i, n2 - i] = output[[1]] * i
}
output
}
Related
Basic question, but unsure how to resolve based on other posts that use vectors of characters or other situations that don't fully enlighten my own simple problem.
I want to make a nested for loop to calculate all possible combinations of two equations (x and y) along two vectors, and store every single calculation.
Here is my code:
n_c = 1
m_c = 1
n_n = 1
m_n = 1
my_data_c = c()
my_data_n = c()
rho_c_store = c()
rho_n_store = c()
for(i in 1:10){
for(j in 1:10){
rho_c = i / 10
rho_n = j / 10
x = (rho_c*n_c)/m_c
y = (rho_n*n_n)/m_n
rho_c_store[i] = rho_c
rho_n_store[j] = rho_n
my_data_c[i] = x
my_data_n[j] = y
my_data = cbind(rho_c_store,rho_n_store,my_data_c,my_data_n)
}
}
print(my_data)
The output I get is:
> print(my_data)
rho_c_store rho_n_store my_data_c my_data_n
[1,] 0.1 0.1 0.1 0.1
[2,] 0.2 0.2 0.2 0.2
[3,] 0.3 0.3 0.3 0.3
[4,] 0.4 0.4 0.4 0.4
[5,] 0.5 0.5 0.5 0.5
[6,] 0.6 0.6 0.6 0.6
[7,] 0.7 0.7 0.7 0.7
[8,] 0.8 0.8 0.8 0.8
[9,] 0.9 0.9 0.9 0.9
[10,] 1.0 1.0 1.0 1.0
However, the data I want is:
> print(my_data)
rho_c_store rho_n_store my_data_c my_data_n
[1,] 0.1 0.1 ? ?
[2,] 0.1 0.2 ? ?
[3,] 0.1 0.3 ? ?
[4,] 0.1 0.4 ? ?
[5,] 0.1 0.5 ? ?
[6,] 0.1 0.6 ? ?
[7,] 0.1 0.7 ? ?
[8,] 0.1 0.8 ? ?
[9,] 0.1 0.9 ? ?
[10,] 0.1 1.0 ? ?
[11,] 0.2 0.1 ? ?
[12,] 0.2 0.2 ? ?
[13,] 0.2 0.3 ? ?
[14,] 0.2 0.4 ? ?
[15,] 0.2 0.5 ? ?
... etc
I know I could solve this in some way with grid.expand() and an apply() function (trying to figure that out in parallel), but I'm annoyed at my inability to solve this basic code setup.
Thanks!
As the others have pointed out you overwrite your elements again and again - you do not actually assign to the row that you mean to. I've included the code that explicitly calculates the index - maybe this is clearer to you. I've also made a few corrections (e.g. you can take the final construction out of the loop).
n_c <- 1 # generally: use <- for assignment
m_c <- 1
n_n <- 1
m_n <- 1
my_data_c <- c() # better: pre-allocate as vector("numeric", 100)
my_data_n <- c()
rho_c_store <- c()
rho_n_store <- c()
for (i in 1:10) {
# you can move this assignment to the outer loop
rho_c <- i / 10
x <- (rho_c * n_c)/m_c
for (j in 1:10) {
rho_n <- j / 10
y <- (rho_n * n_n)/m_n
index <- 10*(i-1) + j
rho_c_store[index] <- rho_c
rho_n_store[index] <- rho_n
my_data_c[index] <- x
my_data_n[index] <- y
}
}
# cbind should be outside the for loop, you only want to build the final
# matrix once you've completed building the vectors
my_data <- cbind(rho_c_store, rho_n_store, my_data_c, my_data_n)
print(my_data)
Hope this helps
The problem is, that you store the variables at the wrong place. In other words when you loop through the second for-loop your i has always the same value. So you store each result of x on the same place. That's why you have to create an index which goes from 1:100 (in your case), and not from 1:10 only.
Hope you understand what I mean.
If I take your code with with some corrections it should look like this
n_c = 1
m_c = 1
n_n = 1
m_n = 1
my_data_c = c()
my_data_n = c()
rho_c_store = c()
rho_n_store = c()
iter = 10
for(i in 1:iter){
sequence = seq(i*iter-iter+1,i*iter)
for(j in 1:iter){
index = sequence[j]
rho_c = i / 10
rho_n = j / 10
x = (rho_c*n_c)/m_c
y = (rho_n*n_n)/m_n
rho_c_store[index] = rho_c
rho_n_store[index] = rho_n
my_data_c[index] = x
my_data_n[index] = y
my_data = cbind(rho_c_store,rho_n_store,my_data_c,my_data_n)
}
}
print(my_data)
In my example my seqence is an altering index which goes from 1 to 10 when i = 1 and then from 11 to 20 and so on.
I hope this is what you meant.
Consider the following column vector:
vec <- rbind(c(0.5),c(0.6))
I want to convert it into the following 4x4 diagonal matrix:
0.5 0 0 0
0 0.6 0 0
0 0 0.5 0
0 0 0 0.6
I know I can do it by the following code:
dia <- diag(c(vec,vec))
But what if I want to convert it into a 1000x1000 diagonal matrix. Then the code above is so efficient. Maybe I can use rep, but I am not totally sure how to do it. How can I do it more efficient?
Here is one other way using recycling:
diag(c(vec), length(vec)*2)
I think your approach is already good enough, here is another way by initialising the matrix and using rep to fill diagonals.
n <- 4
mat <- matrix(0, ncol = n, nrow = n)
diag(mat) <- rep(vec, n/2)
mat
# [,1] [,2] [,3] [,4]
#[1,] 0.5 0.0 0.0 0.0
#[2,] 0.0 0.6 0.0 0.0
#[3,] 0.0 0.0 0.5 0.0
#[4,] 0.0 0.0 0.0 0.6
and following your approach you could do
diag(rep(vec, n/2))
This question already has answers here:
R: How to rescale my matrix by column
(2 answers)
Closed 4 years ago.
I have two matrices of sizes j x i and m x i. What I try to do, is to multiply the i'j element of matrix1 with column i in matrix2. This would give me a vector of size mx1. When this is done for all i elements for a given row j in matrix1, I want to put together these i vectors to a matrix of dimensions mxi. Repeat for all j so that we end up with j mxi matrices
An example might help:
a1 <- c(0.5,0.2,0.2)
a2 <- c(0.2,0.8,0.4)
b1 <- c(3,4)
b2 <- c(1,2)
b <- matrix(0, ncol = 2, nrow = 2)
a <- matrix(0, ncol = 2, nrow = 3)
b[,1] <- b1; b[,2] <- b2
a[,1] <- a1; a[,2] <- a2
Here I want to multiply a[,1] with b[1,1] and then a[,2] with b[1,2] to get
> new.m.j <- cbind(a[,1]*b[1,1], a[,2]*b[1,2])
>
> new.m.j
[,1] [,2]
[1,] 1.5 0.2
[2,] 0.6 0.8
[3,] 0.6 0.4
I want to do this for all j columns in matrix1 to get a list of j matrices.
I can obviously do this with a loop, which would be rather simple. However, I try to teach myself to use more apply (and s/l-apply), and I am pretty sure you could solve this in that way.
Note that new.m.j is simply t(t(a)*b[1,]). You can then use this structure within lapply to produce the list of matricies you want.
lapply(seq(nrow(b)), function(j) t(t(a)*b[j,]))
[[1]]
[,1] [,2]
[1,] 1.5 0.2
[2,] 0.6 0.8
[3,] 0.6 0.4
[[2]]
[,1] [,2]
[1,] 2.0 0.4
[2,] 0.8 1.6
[3,] 0.8 0.8
There are four time intervals
[0, 3), [3, 10), [10, 12), and [12, Inf)
and three subjects for whom we have survival times
10.3, 0.7, 12.2
I would like to construct a matrix with three rows (one for each individual) and four column (one for each time interval) that contains the time spent by each individual within each time interval.
For this particular example, we have
3.0 7 0.3 0.0
0.7 0 0.0 0.0
3.0 7 2.0 0.2
Can you help me to obtain this in R? The idea is to apply this for N much larger than 3.
My attempt:
breaks <- c(0, 3, 10, 12, Inf) # interval break points
M <- length(breaks) - 1 # number of intervals
time <- c(10.3, 0.7, 12.2) # observed survival times
N <- length(time) # number of subjects
timeSpent <- matrix(NA, nrow=N, ncol=M)
for(m in 1:M)
{
ind <- which(breaks[m + 1] - time > 0)
timeSpent[ind, m] <- time[ind] - breaks[m]
timeSpent[-ind, m] <- breaks[m + 1] - breaks[m]
}
timeSpent <- replace(x=timeSpent, list=timeSpent < 0, values=0)
breaks <- c(0, 3, 10, 12, Inf)
time <- c(10.3, 0.7, 12.2)
timeSpent <- sapply(time, function(x) {
int <- max(which(x>breaks))
res <- diff(breaks)
res[int:length(res)] <- 0
res[int] <- x-breaks[int]
res
})
t(timeSpent)
# [,1] [,2] [,3] [,4]
#[1,] 3.0 7 0.3 0.0
#[2,] 0.7 0 0.0 0.0
#[3,] 3.0 7 2.0 0.2
This doesn't loop and should be faster. However, a potential problem could be memory demand.
tmp <- t(outer(time, breaks, ">"))
res <- tmp * breaks
res[is.na(res)] <- 0
res <- diff(res)
res[diff(tmp)==-1] <- time+res[diff(tmp)==-1]
t(res)
# [,1] [,2] [,3] [,4]
#[1,] 3.0 7 0.3 0.0
#[2,] 0.7 0 0.0 0.0
#[3,] 3.0 7 2.0 0.2
I'm trying to model a system of continuous time Markov chains where in different time intervals I have different rates.
I build a rate matrix for each time period like this
make.rate.matrix <- function(c1, c2, m12, m21) {
matrix(
c(# State 1: lineages in different populations
-(m12+m21), m21, m12, 0,
# State 2: both lineages in population 1
2*m12, -(2*m12+c1), 0, c1,
# State 3: both lineages in population 2
2*m21, 0, -(2*m21+c2), c2,
# State 4: coalesced (catches both populations; absorbing)
0, 0, 0, 0),
byrow = TRUE, nrow=4)
}
(if you are interested it is modelling the coalescence density in a two-deme system with migration)
The rates, the cs and ms, differs in different time periods, so I want to build a rate matrix for each time period and then a transition probability matrix for each period.
With two periods I can specify the rates like this
rates <- data.frame(c1 = c(1,2), c2 = c(2,1), m12 = c(0.2, 0.3), m21 = c(0.4, 0.2))
and I want to use the first rates from time 0 to t and the second set of rates from time t to s, say.
So I want to have a table of rate matrices for the first and second period, and probability transition matrices for moving from state a to b through the first and second period.
mlply(rates, make.rate.matrix)
gives me a list of the two rate matrices, and if I want a table where I can easily look up the rate matrices, I can do something like
> xx <- array(unlist(mlply(rates, make.rate.matrix)), dim=c(4,4,2))
> xx[,,1]
[,1] [,2] [,3] [,4]
[1,] -0.6 0.4 0.2 0
[2,] 0.4 -1.4 0.0 1
[3,] 0.8 0.0 -2.8 2
[4,] 0.0 0.0 0.0 0
> xx[,,2]
[,1] [,2] [,3] [,4]
[1,] -0.5 0.2 0.3 0
[2,] 0.6 -2.6 0.0 2
[3,] 0.4 0.0 -1.4 1
[4,] 0.0 0.0 0.0 0
I can then get the probability transition matrices like
> library(Matrix)
> t <- 1; s <- 2
> P1 <- expm(xx[,,1] * t)
> P2 <- expm(xx[,,2] * (s - t))
but I somehow cannot figure out how to get a table of these like I can get for the rate matrices.
I feel that I should be able to get there with aaply, but I am stomped as to how to get there.
How do I get a table P, where P[,,1] is P1 and P[,,2] is P2?