Have the upper triangular matrix from a lower triangular matrix with R - r
I have a vector which is composed of data from a lower triangular matrix.
m_lower <- c(0.3663761172,0.4863082351,0.7465202620,0.4965009484,0.0749920755,4.4082686453,3.2714448866,0.7604404092,1.5994592726,0.2677065512,1.4247358706,1.8448569996,1.9888525802,0.6684931466,0.0909124206,1.2443815645,0.1329758523,0.4777177616,4.7059557222,0.0018111412,3.2430708925,1.7024842083,0.2973714654,1.8145898881,0.8277291485,0.4898066476,0.2827415558,0.2652730958,0.4801885476,1.9012667391,4.2655464241,0.6021593916,0.7127273433,3.6781491268,0.2084725974,0.3147488236,0.0977461927,0.1689097181,0.2176950021,0.0114681239,0.2621692606,0.1242180116,0.0530288130,0.0065052254,0.1241324065,0.3803137139,0.3877225011,0.1456193524,0.0238036494,0.6558033727,0.8803106660,0.0846636279,0.0375347721,0.4605712015,4.7307220442,0.5978980924,4.9502297322,1.6783343118,0.1872433954,0.0096240780,2.5275913377,0.7891683399,0.2747600533,0.8053761872,0.1541668145,0.2320415088,0.9950147294,0.5487573930,0.4876815384,0.0389633056,0.9807247107,2.6210927047,0.1429777740,0.1381647168,0.5751212069,3.1234289486,6.2097230541,0.6347384457,0.2290039612,0.1133552059,0.1790568649,0.0375669532,0.8222290651,0.1216843377,0.0296845741,0.1042203024,1.8920649062,1.3812280928,2.7648752363,0.0506352673,1.9935626852,1.4874099504,0.2729502243,0.2616840959,0.2617474854,0.0813626319,0.5760642438,0.3235973298,0.2360780322,0.4039630140,0.1098278657,0.2043569205,0.3537233928,0.1890846579,0.1392357526,5.5852889211,0.8895464606,4.4717950139,1.4398239163,4.1612760128,1.5346225800,0.6834217952,1.7567290546,1.1563462407,0.0455001087,0.1562431558,0.8705330892,0.5275899123,0.3237870293,1.2863038275,1.6973196296,0.5847098190,2.3223925288,0.5613444343,2.2124772293,1.4562826709,0.8400955943,0.1424881993,0.6683791808,0.8525094744,0.3708594594,1.1009684274,1.5736877623,0.2093061150,0.5452534503,7.3930448949,0.1652496048,0.8540872055,0.1483290331,0.0281819105,0.7922539949,0.2942266303,0.0628311599,0.1691295505,2.4279363796,0.1212368185,0.5582404808,0.1328161192,1.0350547406,5.7389081114,0.1187634510,0.2655712856,0.2854689127,0.1898174381,0.3563226261,0.5320306856,0.1195664207,0.9398889664,0.3591286333,0.0931564303,0.0782904570,5.1694252396,0.3460867771,0.4119580757,0.1127626303,0.6218762663,13.2700188970,0.1119347335,0.4291885095,0.3251606306,4.7433868446,1.9050191397,0.1906132162,0.1333666643,0.0419028810,2.6071857096,0.3753732407,0.3117898454,0.0429600236,0.1713773435,10.7412818563,1.7645514498,0.2214461620,1.7688809751,0.6670375727,0.3626269616,0.0956151063,2.0777759737,0.1852685974,0.3278837993)
picture-matrix-lower
How can I get the whole matrix or the upper triangular matrix from my vector which is composed of data from a lower triangular matrix?
I have no idea if this is what you want
n <- (sqrt(1+8*length(m_lower))+1)/2
m <- matrix(nrow = n,ncol = n)
m[lower.tri(m)] <- m_lower
You can use lower.tri and upper.tri to achive that by something like:
# Create some equivalent, but smaller toy data
n <- 5
X <- matrix(rnorm(n^2), n, n) # Initialize empty matrix
m <- (t(X) + X)/2 # Make symmetric "m"
m_lower <- m[lower.tri(m, diag = TRUE)]
m_lower
# [1] -0.475060360 0.439727314 -0.332462307 0.628518993 -1.528984770 -0.115709110 -1.172260961
# [8] 0.006313545 0.018025707 0.016831925 0.228239570 1.450523622 -0.539834781 -0.152822864
#[15] -0.522060544
# Determine dimension (if square and diagonal included in m_lower)
l <- length(m_lower)
n <- (sqrt(1 + 8*l) - 1)/2 # Solve n*(n + 1) = l for n
# Reconstruct
m2 <- matrix(NA, n, n)
m2[lower.tri(m2, diag = TRUE)] <- m_lower
m2[upper.tri(m2)] <- t(m2)[upper.tri(m2)] # If symmetric, fill also upper half
# Check
all(m == m2)
# [1] TRUE
Edit: Now wrapped into a function which takes additional arguments if the reconstruction should be symmetric and/of if the diagonal is included in m_lower (see answer from ThomasIsCoding).
# Create function for reconstruction
reconstruct <- function(m_lower, diag = TRUE, symmetric = TRUE) {
# Determine dimension (if square and diagonal included in m_lower)
l <- length(m_lower)
n <- (sqrt(1 + 8*l) + ifelse(diag, -1, 1))/2 # Solve n*(n + 1) = l for n
m <- matrix(NA, n, n)
# Reconstruct
m[lower.tri(m, diag = diag)] <- m_lower
if (symmetric) { # If symmetric, fill also upper half
m[upper.tri(m)] <- t(m)[upper.tri(m)]
}
return(m)
}
m3 <- reconstruct(m_lower)
# Check
all(m == m3)
# [1] TRUE
Related
How to compute a probability matrix based on a binary matrix?
My attempt is: library(igraph) set.seed(41) n<-10 A <- sample.int (2, n*n, TRUE)-1L; dim(A) <- c(n,n); m <- sum(A) g <- graph_from_adjacency_matrix(A) k_in <- degree(g, v = V(g), mode = "in", loops = TRUE, normalized = FALSE)#; k_in k_out <- degree(g, v = V(g), mode = "out", loops = TRUE, normalized = FALSE)#; k_out p <- (k_in %*% t(k_out) / (2*m))/(k_in %*% t(k_out) / (2*m) + k_in %*% t(k_out) / (2*m)) round(p, 3) All values of probability matrix p is 0.5. I think the error in the denominator of p, because matrix A is not symmetry. Question. How to specify the denominator correctly? Edit. After the Stéphane Laurent's answer. I think we should have for different value: k_j_out, k_i_in, k_i_out, k_j_in. Finally, I need to obtain the weight matrix, W. I <- matrix(0, n, n); diag(I) <- 1 W <- A %*% (I - P) - t(A) %*% (I - P) And I think this matrix should symmetric.
The 2m is useless because it appears at both the numerator and the denominator. You can do: p <- (k_in %*% t(k_out))/(k_out %*% t(k_in) + k_in %*% t(k_out)) Or, the same with less computations: M <- k_in %*% t(k_out) M / (M + t(M)) EDIT We can check: i <- 2; j <- 3 k_out[j] * k_in[i] / (k_out[j] * k_in[i] + k_out[i] * k_in[j]) # 0.5384615 p[i,j] # 0.5384615
second order neighbors of graph nodes in R
I am looking for an efficient way to find the neighborhoods of exact degree of all nodes in a large graph. Even though it stores graphs as sparse matrices, igraph::ego blows up:
require(Matrix)
require(igraph)
require(ggplot2)
N <- 10^(1:5)
runtimes <- function(N) {
g <- erdos.renyi.game(N, 1/N)
system.time(ego(g, 2, mindist = 2))[3]
}
runtime <- sapply(N, runtimes)
qplot(log10(N), runtime, geom = "line")
Is there a more efficient way?
Using adjacency matrices directly provides a significant improvement.
# sparse adjacency-matrix calculation of indirect neighbors -------------------
diff_sparse_mat <- function(A, B) {
# Difference between sparse matrices.
# Input: sparse matrices A and B
# Output: C = (A & !B), using element-wise diffing, treating B as logical
stopifnot(identical(dim(A), dim(B)))
A <- as(A, "generalMatrix")
AT <- as.data.table(summary(as(A, "TsparseMatrix")))
setkeyv(AT, c("i", "j"))
B <- drop0(B)
B <- as(B, "generalMatrix")
BT <- as.data.table(summary(as(B, "TsparseMatrix")))
setkeyv(BT, c("i", "j"))
C <- AT[!BT]
if (length(C) == 2) {
return(sparseMatrix(i = C$i, j = C$j, dims = dim(A)))
} else {
return(sparseMatrix(i = C$i, j = C$j, x = C$x, dims = dim(A)))
}
}
distance2_peers <- function(adj_mat) {
# Returns a matrix of indirect neighbors, excluding the diagonal
# Input: adjacency matrix A (assumed symmetric)
# Output: (A %*% A & !A) with zero diagonal
indirect <- forceSymmetric(adj_mat %*% adj_mat)
indirect <- diff_sparse_mat(indirect, adj_mat) # excl. direct neighbors
indirect <- diff_sparse_mat(indirect, Diagonal(n = dim(indirect)[1])) # excl. diag.
return(indirect)
}
for the Erdos Renyi example, in half a minute now a network of 10^7, not 10^5 can be analyzed:
N <- 10 ^ (1:7)
runtimes <- function(N) {
g <- erdos.renyi.game(N, 1 / N, directed = FALSE)
system.time(distance2_peers(as_adjacency_matrix(g)))[3]
}
runtime <- sapply(N, runtimes)
qplot(log10(N), runtime, geom = "line")
The resulting matrix containst at (i, j) the number of paths from i to j of length 2 (excluding paths that include i itself).
Regularized Latent Semantic Indexing in R
I am trying to implement the Regularized Latent Semantic Indexing (RLSI) algorithm on R.
The original paper can be found here:
http://research.microsoft.com/en-us/people/hangli/sigirfp372-wang.pdf
Below is my code.
Here, I generate a matrix D from two matrices U and V. Each column of U correspond to a topic vector, and it is made to be sparse. After that, I apply RLSI on the D matrix to see if I can factorize it into two matrices, one of which has sparse vectors like U.
However, the resulting U is far from being sparse. Actually, every element of it is filled with numbers.
Is there something wrong with my code?
Thank you very much in advance.
library(magrittr)
# functions
updateU <- function(D,U,V){
S <- V %*% t(V)
R <- D %*% t(V)
for(m in 1:M){
u_m <- rep(0, K)
u_previous <- u_m
diff_u <- 100
while(diff_u > 0.1){
for(k in 1:K){
w_mk <- R[m,k] - S[k,-k] %*% U[m,-k]
in_hinge <- (abs(w_mk) - 0.5 * lambda_1)
u_m[k] <- (ifelse(in_hinge > 0, in_hinge, 0) * ifelse(w_mk >= 0, 1, -1)) / S[k,k]
}
diff_u <- sum(u_m - u_previous)
u_previous <- u_m
}
U[m,] <- u_m
}
return(U)
}
updateV <- function(D,U,V){
Sigma <- solve(t(U) %*% U + lambda_2 * diag(K))
Phi <- t(U) %*% D
V <- Sigma %*% Phi
return(V)
}
# Set constants
M <- 5000
N <- 1000
K <- 30
lambda_1 <- 1
lambda_2 <- 0.5
# Create D
originalU <- c(rpois(50000, lambda = 10), rep(0, 100000)) %>% sample(., 150000) %>% matrix(., M, K)
originalV <- rpois(30000, lambda = 5) %>% sample(., 30000) %>% matrix(., K, N)
D <- originalU %*% originalV
# Initialize U and V
V <- matrix(rpois(30000, lambda = 5), K, N)
U <- matrix(0, M, K)
# Run RLSI (iterate 100 times for now)
for(t in 1:100){
cat(t,":")
U <- updateU(D,U,V)
V <- updateV(D,U,V)
loss <- sum((D - U %*% V) ^ 2)
cat(loss, "\n")
}
I've got it. Each row in U has to be set to a zero vector each time updateU function is run.
R: Generate matrix from function
In R I'm interested in the general case to generate a matrix from a formula such as: X = some other matrix Y(i, j) = X(i, j) + Y(i - 1, j - 1) Unfortunately I can't find how to account for the matrix self-referencing. Obviously order of execution and bounds checking are factors here, but I imagine these could be accounted for by the matrix orientation and formula respetively. Thanks.
This solution assumes that you want Y[1,n] == X[1,n] and Y[n,1] == X[n,1]. If not, you can apply the same solution on the sub-matrix X[-1,-1] to fill in the values of Y[-1,-1]. It also assumes that the input matrix is square.
We use the fact that Y[N,N] = X[N,N] + X[N-1, N-1] + ... + X[1,1] plus similar relations for off-diagonal elements. Note that off-diagonal elements are a diagonal of a particular sub-matrix.
# Example input
X <- matrix(1:16, ncol=4)
Y <- matrix(0, ncol=ncol(X), nrow=nrow(X))
diag(Y) <- cumsum(diag(X))
Y[1,ncol(X)] <- X[1,ncol(X)]
Y[nrow(X),1] <- X[nrow(X),1]
for (i in 1:(nrow(X)-2)) {
ind <- seq(i)
diag(Y[-ind,]) <- cumsum(diag(X[-ind,])) # lower triangle
diag(Y[,-ind]) <- cumsum(diag(X[,-ind])) # upper triangle
}
Well, you can always use a for loop:
Y <- matrix(0, ncol=3, nrow=3)
#boundary values:
Y[1,] <- 1
Y[,1] <- 2
X <- matrix(1:9, ncol=3)
for (i in 2:nrow(Y)) {
for (j in 2:ncol(Y)) {
Y[i, j] <- X[i, j] + Y[i-1, j-1]
}
}
If that is too slow you can translate it to C++ (using Rcpp) easily.
Optimisation in R using Ucminf package
I am not able to apply ucminf function to minimise my cost function in R.
Here is my cost function:
costfunction <- function(X,y,theta){
m <- length(y);
J = 1/m * ((-t(y)%*%log(sigmoid(as.matrix(X)%*%as.matrix(theta)))) - ((1-t(y))%*%log(1-sigmoid(as.matrix(X)%*%as.matrix(theta)))))
}
Here is my sigmoid function:
sigmoid <- function(t){
g = 1./(1+exp(-t))
}
Here is my gradient function:
gradfunction <- function(X,y,theta){
grad = 1/ m * t(X) %*% (sigmoid(as.matrix(X) %*% as.matrix(theta) - y));
}
I am trying to do the following:
library("ucminf")
data <- read.csv("ex2data1.txt",header=FALSE)
X <<- data[,c(1,2)]
y <<- data[,3]
qplot(X[,1],X[,2],colour=factor(y))
m <- dim(X)[1]
n <- dim(X)[2]
X <- cbind(1,X)
initial_theta <<- matrix(0,nrow=n+1,ncol=1)
cost <- costfunction(X,y,initial_theta)
grad <- gradfunction(X,y,initial_theta)
This is where I want to call ucminf to find the minimum cost and values of theta. I am not sure how to do this.
Looks like you are trying to do the week2 problem of the machine learning course of Coursera.
No need to use ucminf packages here, you can simply use the R function optim it works
We will define the sigmoid and cost function first.
sigmoid <- function(z)
1 / (1 + exp(-z))
costFunction <- function(theta, X, y) {
m <- length(y)
J <- -(1 / m) * crossprod(c(y, 1 - y),
c(log(sigmoid(X %*% theta)), log(1 - sigmoid(X %*% theta))))
grad <- (1 / m) * crossprod(X, sigmoid(X %*% theta) - y)
list(J = J, grad = grad)
}
Let's load the data now, to make this code it reproductible, I put the data in my dropbox.
download.file("https://dl.dropboxusercontent.com/u/8750577/ex2data1.txt",
method = "curl", destfile = "/tmp/ex2data1.txt")
data <- matrix(scan('/tmp/ex2data1.txt', what = double(), sep = ","),
ncol = 3, byrow = TRUE)
X <- data[, 1:2]
y <- data[, 3, drop = FALSE]
m <- nrow(X)
n <- ncol(X)
X <- cbind(1, X)
initial_theta = matrix(0, nrow = n + 1)
We can then compute the result of the cost function at the initial theta like this
cost <- costFunction(initial_theta, X, y)
(grad <- cost$grad)
## [,1]
## [1,] -0.100
## [2,] -12.009
## [3,] -11.263
(cost <- cost$J)
## [,1]
## [1,] 0.69315
Finally we can use optim to ge the optimal theta
res <- optim(par = initial_theta,
fn = function(t) costFunction(t, X, y)$J,
gr = function(t) costFunction(t, X, y)$grad,
method = "BFGS", control = list(maxit = 400))
(theta <- res$par)
## [,1]
## [1,] -25.08949
## [2,] 0.20566
## [3,] 0.20089
(cost <- res$value)
## [1] 0.2035
If you have some problem with the function download.file, the data can be downloaded
here
As you did not provide a reproducible example it is hard to exactly give you the code you need, but the general idea is to hand the functions over to ucminf: ucminf(start, costfunction, gradfunction, y = y, theta = initial_theta) Note that start needs to be a vector of initial starting values which when handed over as X to the two functions need to produce a result. Usually you use random starting value (e.g., runif).