Related
I would like to recreate the following calculation with a random matrix:
I started out with the following, which gives a result:
kmin1 <- cbind(1:10,1:10,6:15,1:10,1:10,6:15,1:10,1:10,6:15)
C <- cbind(1, kmin1) # Column of 1s
diag(C) <- 1
Ccrosprod <-crossprod(C) # C'C
Ctranspose <- t(C) # C'
CCtransposeinv <- solve(Ccrosprod) # (C'C)^-1
W <- Ctranspose %*% CCtransposeinv # W=(C'C)^-1*C'
My assumption is however that C should be able to be an m x n matrix, as there is no good reason to assume that factors equal observations.
EDIT: Based on the comment by Hong Ooi, I changed kmin1 <- matrix(rexp(200, rate=.1), ncol=20) into kmin1 <- matrix(rexp(200, rate=.1), nrow=20)
I checked the wikipedia and learned that an m x n might have a left or a right inverse. To put this into practice I attempted the following:
kmin1 <- matrix(rexp(200, rate=.1), nrow=20)
C <- cbind(1, kmin1) # Column of 1s
Ccrosprod <-crossprod(C) # C'C
Ctranspose <- t(C) # C'
CCtransposeinv <- solve(Ccrosprod) # (C'C)^-1
W <- Ctranspose %*% CCtransposeinv # W=(C'C)^-1*C'
EDIT: Based on the comments below this questions everything works.
I would post this on stackexchange if I was sure this did not have anything to do with syntax, but as I am not experienced with matrices I am not sure.
If the columns of C are linearly independent then C'C is invertible and (C'C)-1C' equals any of these:
set.seed(123)
kmin1 <- matrix(rexp(200, rate=.1), nrow=20)
C <- cbind(1, kmin1)
r1 <- solve(crossprod(C), t(C))
r2 <- qr.solve(crossprod(C), t(C))
r3 <- chol2inv(chol(crossprod(C))) %*% t(C)
r4 <- with(svd(C), v %*% diag(1/d) %*% t(u))
r5 <- with(eigen(crossprod(C)), vectors %*% diag(1/values) %*% t(vectors)) %*% t(C)
r6 <- coef(lm.fit(C, diag(nrow(C))))
# check
all.equal(r1, r2)
## [1] TRUE
all.equal(r1, r3)
## [1] TRUE
all.equal(r1, r4)
## [1] TRUE
all.equal(r1, r5)
## [1] TRUE
dimnames(r6) <- NULL
all.equal(r1, r6)
## [1] TRUE
If C'C is not necessarily invertible then the answer is not necessarily unique (although if we were interested in C(C'C)-C' then that would be unique even though the pseudoinverse of C'C may not be). At any rate we can form one pseudo inverse by taking the singular value decomposition (or the eigenvalue decomposition) and using the reciprocal of the singular values (or eigenvalues) and using 0 for those that are near 0. This is equivalent to using the Moore Penrose pseudo inverse. (The lm.fit approach shown above will work too but will generate some NAs in the result.)
set.seed(123)
kmin1 <- matrix(rexp(200, rate=.1), nrow=20)
C <- cbind(1, kmin1)
C[, 11] <- C[, 2] + C[, 3] # force singularity
eps <- 1.e-5
s1 <- with(svd(C), v %*% diag(ifelse(abs(d) < eps, 0, 1/(d))) %*% t(u))
s2 <- with(eigen(crossprod(C)),
vectors %*% diag(ifelse(abs(values) < eps, 0, 1/values)) %*% t(vectors)) %*% t(C)
# check
all.equal(s1, s2)
## [1] TRUE
First off, I am not familiar with your area of research/work (econometrics?), so I'm not sure whether the following is sensible from a domain-specific knowledge point of view.
That aside, the library MASS allows to calculate the Moore-Penrose generalised inverse of a non-square matrix.
So a potential generalisation of your calculations to non-square matrices could look like
library(MASS)
W <- ginv(t(C) %*% C) %*% t(C)
I have to compute a product of 3 matrices D=ABC with:
A is a (1x3) matrix,
B is a (3x3) matrix,
C is a (3x1) matrix (and is equal to A', if it matters)
The result of this product is a simple value, and the calculation is very straightforward in R.
My problem is there is one unknown, namely X, inside A and C, and I would like to get the result as a formula: D = ABD = f(X).
Is there any way I could achieve this with R ?
Define D as shown below where argument B is the square matrix and A is a function of x returning a vector.
D <- function(B, A) function(x) t(A(x)) %*% B %*% A(x)
# test
A <- function(x) seq(3) * x
B <- matrix(1:9, 3)
Dfun <- D(B, A)
Dfun(10)
## [1] 22800
I am quite new to R-Cran. I would like to solve a linear inverse model with constrains. I am using the ldei-function in the limSolve package.
Here are my linear system and constrains:
A x X = C
G x X >=H, with G=I and H=0. (Basically: X>=0)
where:
A in a 2x2 matrix;
X (nrow=2, ncol=n) is the unknown-vector-(matrix);
C (nrow=2, ncol=n) is the constant-known vector-(matrix).
The matrix G is the identity matrix and H is a vector-(matrix) with zero values.
The constrain X>=0 needs to be satisfied as X represents concentrations of nitrogen dioxide and ozone in outdoor air, and they cannot be negative.
Here is my r-code, I assume n=10:
library(limSolve)
A <- matrix(data = NA, nrow=2,ncol=2)
A[1,c(1:2)] <- c(-3.956946e-05,-1.558643e-05)
A[2,c(1:2)] <- c(-8.785099e-05, 1.540414e-04)
ctmp1 <- c(-3.000286e-04,-0.0003545647,-0.0002958569,-0.000356863,-0.0003602479,-0.0004177914,-0.0004280350,-0.0003890670,-0.0004984785,-0.0005695379)
ctmp2 <- c(-6.462205e-05,-0.0007740174,-0.0006427914,-0.001056369,-0.0009569179,-0.0008562010,-0.0005402486,-0.0005043381,-0.0006366220,-0.0009332219)
inC <- rbind(ctmp1,ctmp2)
C <- matrix(data=inC, nrow=2, ncol=10)
G <- matrix(ncol=2,nrow=2,data= c(1,0,0,1))
inH <- rbind(rep(0., length.out=10),rep(0., length.out=10))
H <- matrix(data=inH, nrow=2, ncol=10)
# I am aware I need to use the apply-family instead of do loops-- this is my work in progress--..
for (i in 1:10){
print(i)
E <- A
FF <- c(C[1,i],C[2,i])
GG <- G
HH <- H[,i]
res <-ldei(E,FF,GG,HH)
print(res$X)
}
### Here the output:
[1] 1
[1] 6.326385 3.188475
[1] 2
[1] 8.93305028 0.06985077
[1] 3
[1] 7.44753875 0.07454004
[1] 4
Error in svd(V2, nu = 0, nv = unsolvable) : a dimension is zero
I would be very grateful for any hint to solve the issue:
"Error in svd(V2, nu = 0, nv = unsolvable) : a dimension is zero"
Many thanks for your help!
Firstly, welcome to R!
If you want to see the code for a function you can just type the name of the function without paretheses and R shows the code. So, for svd, we can see that it gives the error you see when there aren't enough dimensions... which means the as.matrix(x) hasn't given an object with dimensions, which means its input x must be not quite as expected.
You can edit these functions too... for debugging purposes. I normally just paste into a text editor, edit and paste back into R.
svd = function (x, nu = min(n, p), nv = min(n, p), LINPACK = FALSE)
{
x <- as.matrix(x)
if (any(!is.finite(x)))
stop("infinite or missing values in 'x'")
dx <- dim(x)
n <- dx[1L]
p <- dx[2L]
if (!n || !p) {
print("x")
print(x)
print("dx")
print(dx)
print("dx1L")
print (dx[1L])
print("dx2L")
print(dx[2L])
stop("a dimension is zero");}
La.res <- La.svd(x, nu, nv)
res <- list(d = La.res$d)
if (nu)
res$u <- La.res$u
if (nv) {
if (is.complex(x))
res$v <- Conj(t(La.res$vt))
else res$v <- t(La.res$vt)
}
res
}
I've made it print out the values of interest...
[1] "x"
[1,]
[2,]
[1] "dx"
[1] 2 0
[1] "dx1L"
[1] 2
[1] "dx2L"
[1] 0
As suspected, the input has no data...
I pulled the same trick in ldei to get the values of E and V2 (which are the x given to svd) I won't put that code here as it's a big much.
The upshot of it is that rnd in
V2 <- V2 %*% rnd
is width 0 because
unsolvable <- Nx - solvable
...
rnd <- matrix(data = runif(Nx * unsolvable), nrow = Nx,
ncol = unsolvable)
and both Nx and solvable are equal to 2!
The reason it even reaches that part of the code is that no all of CC are bigger than -tol... in this case:
[1] "CC"
[,1]
[1,] 9.570040
[2,] -1.399828
[1] "-tol"
[1] -1.490116e-08
Ultimately, the difference in CC is because of the value of F.
So my guess is that the case where FF = c(C[1,4],C[2,4]) produces an error that is not handled by the function.
Sorry I can't do better!
Following the tips Jimi provided, which I am really grateful for, I contacted directly the maintainer. Here below are her suggestions to "skip" the error. They worked for my case.
"The error means that the system is not solvable with ldei, and the function does not catch the error. What you can do is:
for (i in 1:10){
print(i)
E <- A
FF <- c(C[1,i],C[2,i])
GG <- G
HH <- H[,i]
res <-try(ldei(E,FF,GG,HH))
if (! class(res)%in% "try-error")
print(res$X)
}
Therefore, when class(res)%in% "try-error", then it is not solvable (likely at the requested precision)"
I have a setup that looks like below
for(V in (seq(1, 250, by = 5))){
for(n in (seq(1, 250, by = 5))){
# 1) Working Algorithm creating a probability
ie. vector in range [0:1]
# 2) Take the natural log of this probability
a <- log(lag(Probability), base = exp(1))
# 3) calculate price differences
b <- abs(diff(Price) -1)
# 4) Then compute correlation between a and b
cor(a, b)
# 5) Here I'd like to save this in the corresponding index of matrix
}
}
So that I get a [V, n] sized matrix as output, that collects from each loop.
I have a few problems with this.
The first problem is that my correlation is not computable, as the Probability is often 0, creating a ln(0) = -Inf input in the ln(Probability) vector. Is there a way to compute the std.dev or cor of a Ln vector with -Inf inputs?
My second question is how I save this correlation output into a matrix generated for each loop?
Thanks for your help. I hope this is clear enough.
For your second question (My second question is how I save this correlation output into a matrix generated for each loop?), you could initialise a matrix before the loop and store each computed correlation in the corresponding index like:
sz <- seq(1, 250, by = 5)
out_mat <- matrix(0, nrow=length(sz), ncol=length(sz))
# then continue with your for-loop
for (V in 1:length(sz)) {
for(n in length(sz)) {
# here instead of accessing V and n in computing probability
# use sz[V] and sz[n]
...
...
# after computing the correlation, here use V and n (not sz[V] or sz[n])
out_mat[V, n] <- c # c holds the value of cor(a,b)
}
}
What you can do with -Inf is replace that by NA, for example:
x = runif(10)
x[3] = 1/0
> is.infinite(x)
[1] FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
x[is.infinite(x)] <- NA
> x
[1] 0.09936348 0.66624531 NA 0.90689357 0.71578917 0.14655174
[7] 0.59561047 0.41944552 0.67203026 0.03263173
And use the na.rm argument for sd:
> sd(x, na.rm = TRUE)
[1] 0.3126829
I tried norm, but I think it gives the wrong result. (the norm of c(1, 2, 3) is sqrt(1*1+2*2+3*3), but it returns 6..
x1 <- 1:3
norm(x1)
# Error in norm(x1) : 'A' must be a numeric matrix
norm(as.matrix(x1))
# [1] 6
as.matrix(x1)
# [,1]
# [1,] 1
# [2,] 2
# [3,] 3
norm(as.matrix(x1))
# [1] 6
Does anyone know what's the function to calculate the norm of a vector in R?
norm(c(1,1), type="2") # 1.414214
norm(c(1, 1, 1), type="2") # 1.732051
This is a trivial function to write yourself:
norm_vec <- function(x) sqrt(sum(x^2))
I was surprised that nobody had tried profiling the results for the above suggested methods, so I did that. I've used a random uniform function to generate a list and used that for repetition (Just a simple back of the envelop type of benchmark):
> uut <- lapply(1:100000, function(x) {runif(1000, min=-10^10, max=10^10)})
> norm_vec <- function(x) sqrt(sum(x^2))
> norm_vec2 <- function(x){sqrt(crossprod(x))}
>
> system.time(lapply(uut, norm_vec))
user system elapsed
0.58 0.00 0.58
> system.time(lapply(uut, norm_vec2))
user system elapsed
0.35 0.00 0.34
> system.time(lapply(uut, norm, type="2"))
user system elapsed
6.75 0.00 6.78
> system.time(lapply(lapply(uut, as.matrix), norm))
user system elapsed
2.70 0.00 2.73
It seems that taking the power and then sqrt manually is faster than the builtin norm for real values vectors at least. This is probably because norm internally does an SVD:
> norm
function (x, type = c("O", "I", "F", "M", "2"))
{
if (identical("2", type)) {
svd(x, nu = 0L, nv = 0L)$d[1L]
}
else .Internal(La_dlange(x, type))
}
and the SVD function internally converts the vector into a matrix, and does more complicated stuff:
> svd
function (x, nu = min(n, p), nv = min(n, p), LINPACK = FALSE)
{
x <- as.matrix(x)
...
EDIT (20 Oct 2019):
There have been some comments to point out the correctness issue which the above test case doesn't bring out:
> norm_vec(c(10^155))
[1] Inf
> norm(c(10^155), type="2")
[1] 1e+155
This happens because large numbers are considered as infinity in R:
> 10^309
[1] Inf
So, it looks like:
It seems that taking the power and then sqrt manually is faster than the builtin norm for real values vectors for small numbers.
How small? So that the sum of squares doesn't overflow.
norm(x, type = c("O", "I", "F", "M", "2"))
The default is "O".
"O", "o" or "1" specifies the one norm, (maximum absolute column sum);
"F" or "f" specifies the Frobenius norm (the Euclidean norm of x treated as if it were a vector);
norm(as.matrix(x1),"o")
The result is 6, same as norm(as.matrix(x1))
norm(as.matrix(x1),"f")
The result is sqrt(1*1+2*2+3*3)
So, norm(as.matrix(x1),"f") is answer.
We can also find the norm as :
Result<-sum(abs(x)^2)^(1/2)
OR Even You can also try as:
Result<-sqrt(t(x)%*%x)
Both will give the same answer
I'mma throw this out there too as an equivalent R expression
norm_vec(x) <- function(x){sqrt(crossprod(x))}
Don't confuse R's crossprod with a similarly named vector/cross product. That naming is known to cause confusion especially for those with a physics/mechanics background.
Answer for Euclidean length of a vector (k-norm) with scaling to avoid destructive underflow and overflow is
norm <- function(x, k) { max(abs(x))*(sum((abs(x)/max(abs(x)))^k))^(1/k) }
See below for explanation.
1. Euclidean length of a vector with no scaling:
norm() is a vector-valued function which computes the length of the vector. It takes two arguments such as the vector x of class matrix and the type of norm k of class integer.
norm <- function(x, k) {
# x = matrix with column vector and with dimensions mx1 or mxn
# k = type of norm with integer from 1 to +Inf
stopifnot(k >= 1) # check for the integer value of k greater than 0
stopifnot(length(k) == 1) # check for length of k to be 1. The variable k is not vectorized.
if(k == Inf) {
# infinity norm
return(apply(x, 2, function(vec) max(abs(vec)) ))
} else {
# k-norm
return(apply(x, 2, function(vec) (sum((abs(vec))^k))^(1/k) ))
}
}
x <- matrix(c(1,-2,3,-4)) # column matrix
sapply(c(1:4, Inf), function(k) norm(x = x, k = k))
# [1] 10.000000 5.477226 4.641589 4.337613 4.000000
1-norm (10.0) converges to infinity-norm (4.0).
k-norm is also called as "Euclidean norm in Euclidean n-dimensional space".
Note:
In the norm() function definition, for vectors with real components, the absolute values can be dropped in norm-2k or even indexed norms, where k >= 1.
If you are confused with the norm function definition, you can read each one individually as given below.
norm_1 <- function(x) sum(abs(x))
norm_2 <- function(x) (sum((abs(x))^2))^(1/2)
norm_3 <- function(x) (sum((abs(x))^3))^(1/3)
norm_4 <- function(x) (sum((abs(x))^4))^(1/4)
norm_k <- function(x) (sum((abs(x))^k))^(1/k)
norm_inf <- max(abs(x))
2. Euclidean length of a vector with scaling to avoid destructive overflow and underflow issues:
Note-2:
The only problem with this solution norm() is that it does not guard against overflow or underflow problems as alluded here and here.
Fortunately, someone had already solved this problem for 2-norm (euclidean length) in the blas (basic linear algebra subroutines) fortran library. A description of this problem can be found in the textbook of "Numerical Methods and Software by Kahaner, Moler and Nash" - Chapter-1, Section 1.3, page - 7-9.
The name of the fortran subroutine is dnrm2.f, which handles destructive overflow and underflow issues in the norm() by scaling with the maximum of the vector components. The destructive overflow and underflow problem arise due to radical operation in the norm() function.
I will show how to implement dnrm2.f in R below.
#1. find the maximum among components of vector-x
max_x <- max(x)
#2. scale or divide the components of vector by max_x
scaled_x <- x/max_x
#3. take square of the scaled vector-x
sq_scaled_x <- (scaled_x)^2
#4. sum the square of scaled vector-x
sum_sq_scaled_x <- sum(sq_scaled_x)
#5. take square root of sum_sq_scaled_x
rt_sum_sq_scaled_x <- sqrt(sum_sq_scaled_x)
#6. multiply the maximum of vector x with rt_sum_sq_scaled_x
max_x*rt_sum_sq_scaled_x
one-liner of the above 6-steps of dnrm2.f in R is:
# Euclidean length of vector - 2norm
max(x)*sqrt(sum((x/max(x))^2))
Lets try example vectors to compute 2-norm (see other solutions in this thread) for this problem.
x = c(-8e+299, -6e+299, 5e+299, -8e+298, -5e+299)
max(x)*sqrt(sum((x/max(x))^2))
# [1] 1.227355e+300
x <- (c(1,-2,3,-4))
max(x)*sqrt(sum((x/max(x))^2))
# [1] 5.477226
Therefore, the recommended way to implement a generalized solution for k-norm in R is that single line, which guard against the destructive overflow or underflow problems. To improve this one-liner, you can use a combination of norm() without scaling for a vector containing not-too-small or not-too-large components and knorm() with scaling for a vector with too-small or too-large components. Implementing scaling for all vectors results in too many calculations. I did not implement this improvement in knorm() given below.
# one-liner for k-norm - generalized form for all norms including infinity-norm:
max(abs(x))*(sum((abs(x)/max(abs(x)))^k))^(1/k)
# knorm() function using the above one-liner.
knorm <- function(x, k) {
# x = matrix with column vector and with dimensions mx1 or mxn
# k = type of norm with integer from 1 to +Inf
stopifnot(k >= 1) # check for the integer value of k greater than 0
stopifnot(length(k) == 1) # check for length of k to be 1. The variable k is not vectorized.
# covert elements of matrix to its absolute values
x <- abs(x)
if(k == Inf) { # infinity-norm
return(apply(x, 2, function(vec) max(vec)))
} else { # k-norm
return(apply(x, 2, function(vec) {
max_vec <- max(vec)
return(max_vec*(sum((vec/max_vec)^k))^(1/k))
}))
}
}
# 2-norm
x <- matrix(c(-8e+299, -6e+299, 5e+299, -8e+298, -5e+299))
sapply(2, function(k) knorm(x = x, k = k))
# [1] 1.227355e+300
# 1-norm, 2-norm, 3-norm, 4-norm, and infinity-norm
sapply(c(1:4, Inf), function(k) knorm(x = x, k = k))
# [1] 2.480000e+300 1.227355e+300 9.927854e+299 9.027789e+299 8.000000e+299
x <- matrix(c(1,-2,3,-4))
sapply(c(1:4, Inf), function(k) knorm(x = x, k = k))
# [1] 10.000000 5.477226 4.641589 4.337613 4.000000
x <- matrix(c(1,-2,3,-4, 0, -8e+299, -6e+299, 5e+299, -8e+298, -5e+299), nc = 2)
sapply(c(1:4, Inf), function(k) knorm(x = x, k = k))
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1.00e+01 5.477226e+00 4.641589e+00 4.337613e+00 4e+00
# [2,] 2.48e+300 1.227355e+300 9.927854e+299 9.027789e+299 8e+299
If you have a data.frame or a data.table 'DT', and want to compute the Euclidian norm (norm 2) across each row, the apply function can be used.
apply(X = DT, MARGIN = 1, FUN = norm, '2')
Example:
>DT
accx accy accz
1: 9.576807 -0.1629486 -0.2587167
2: 9.576807 -0.1722938 -0.2681506
3: 9.576807 -0.1634264 -0.2681506
4: 9.576807 -0.1545590 -0.2681506
5: 9.576807 -0.1621254 -0.2681506
6: 9.576807 -0.1723825 -0.2682434
7: 9.576807 -0.1723825 -0.2728810
8: 9.576807 -0.1723825 -0.2775187
> apply(X = DT, MARGIN = 1, FUN = norm, '2')
[1] 9.581687 9.582109 9.581954 9.581807 9.581932 9.582114 9.582245 9.582378
Following AbdealiJK's answer,
I experimented further to gain some insight.
Here's one.
x = c(-8e+299, -6e+299, 5e+299, -8e+298, -5e+299)
sqrt(sum(x^2))
norm(x, type='2')
The first result is Inf and the second one is 1.227355e+300 which is quite correct as I show you in the code below.
library(Rmpfr)
y <- mpfr(x, 120)
sqrt(sum(y*y))
The result is 1227354879.... I didn't count the number of trailing numbers but it looks all right. I know there another way around this OVERFLOW problem which is first applying log function to all numbers and summing up, which I do not have time to implement!
Create your matrix as column vise using cbind then the norm function works well with Frobenius norm (the Euclidean norm) as an argument.
x1<-cbind(1:3)
norm(x1,"f")
[1] 3.741657
sqrt(1*1+2*2+3*3)
[1] 3.741657