Replacing upper triangular matrix elements in row order - r

I have a square matrix as follows.
> ex_mat
[,1] [,2] [,3] [,4]
[1,] 0.4270634 2.1920890 0.5647472 1.7149861
[2,] 2.0556220 1.1157322 2.6723637 0.3155507
[3,] 1.2252602 0.1063053 0.6396099 0.7903348
[4,] 0.3614062 1.1118661 0.5000143 0.2491543
I've ranked the upper off-diagonal part of the matrix in row order (from largest to smallest) with this.
> rank(-(t(ex_mat)[lower.tri(ex_mat)]))
[1] 2 5 3 1 6 4
I want to replace the upper off-diagonal elements of "ex_mat" with the ranks obtained above. I'm using https://statisticsglobe.com/modify-diagonal-lower-upper-triangular-part-matrix-r as example code. While my ranks are correct, the code seems to be inserting the ranks in column order.
> ex_mat_new <- ex_mat
> ex_mat_new[upper.tri(ex_mat_new)] <- rank(-(t(ex_mat)[lower.tri(ex_mat)]))
> ex_mat_new
[,1] [,2] [,3] [,4]
[1,] 0.4270634 2.0000000 5.0000000 1.0000000
[2,] 2.0556220 1.1157322 3.0000000 6.0000000
[3,] 1.2252602 0.1063053 0.6396099 4.0000000
[4,] 0.3614062 1.1118661 0.5000143 0.2491543
How can I fix this? [1,4] and [2,3] are off. Thank you.

The value insertions are in column order (in matrix, data.frame). We may assign on the lower.tri and then get the transpose
ex_mat_new[lower.tri(ex_mat_new)] <- rank(-(t(ex_mat)[lower.tri(ex_mat)]))
ex_mat_new <- t(ex_mat_new)
ex_mat_new[lower.tri(ex_mat_new)] <- ex_mat[lower.tri(ex_mat)]
-output
> ex_mat_new
[,1] [,2] [,3] [,4]
[1,] 0.4270634 2.0000000 5.0000000 3.0000000
[2,] 2.0556220 1.1157322 1.0000000 6.0000000
[3,] 1.2252602 0.1063053 0.6396099 4.0000000
[4,] 0.3614062 1.1118661 0.5000143 0.2491543
or this can be done in a single line with replace
t(replace(t(ex_mat), lower.tri(ex_mat), rank(-(t(ex_mat)[lower.tri(ex_mat)]))))
-output
[,1] [,2] [,3] [,4]
[1,] 0.4270634 2.0000000 5.0000000 3.0000000
[2,] 2.0556220 1.1157322 1.0000000 6.0000000
[3,] 1.2252602 0.1063053 0.6396099 4.0000000
[4,] 0.3614062 1.1118661 0.5000143 0.2491543
data
ex_mat <- structure(c(0.4270634, 2.055622, 1.2252602, 0.3614062, 2.192089,
1.1157322, 0.1063053, 1.1118661, 0.5647472, 2.6723637, 0.6396099,
0.5000143, 1.7149861, 0.3155507, 0.7903348, 0.2491543), .Dim = c(4L,
4L), .Dimnames = list(NULL, NULL))

Related

Return position of specific element in matrix - R

I have similarity value matrix (m) as bellow:
[,1] [,2] [,3]
[1,] 1.0000000 1.0000000 0.8579698
[2,] 1.0000000 1.0000000 0.8579698
[3,] 0.8579698 0.8579698 1.0000000
I would like to get the position of 0.8579698 by easy way .
I have tried to use which function
it works fine for element 1.
which( m == 1.0000000, TRUE)
Any idea ?
The question doesn't say how this matrix has been constructed, but this problem seems to arise from 0.8579698 being the truncated expression of a real (float) value. In general, you can't use exact equality for real values:
> .72==.72
[1] TRUE
But:
> sqrt(.72)
[1] 0.8485281
> sqrt(.72)==0.8485281
[1] FALSE
There is a small difference between those apparently equal numbers:
> sqrt(.72)-0.8485281
[1] 3.742386e-08
A common workaround is to use a difference threshold instead of an equality:
> m<-matrix(c(1,1,.72,1,1,.72,.72,.72,1),nrow=3,ncol=3)
> (m<-sqrt(m))
[,1] [,2] [,3]
[1,] 1.0000000 1.0000000 0.8485281
[2,] 1.0000000 1.0000000 0.8485281
[3,] 0.8485281 0.8485281 1.0000000
> which(abs(m-.8485)<.0001,arr.ind = TRUE)
row col
[1,] 3 1
[2,] 3 2
[3,] 1 3
[4,] 2 3

Trying to pass more than 2 vectors to a function in R

I want to compute e^(ax+b) over a=-1:1 and b=-1:1 for various values of X. I want the output in the form a list of 5 elements. Each element in the list is 3X3 Matrix.
I did achieve this using Outer and Vectorize.
sigm = function(a=0,b=0,x){
return(exp(x*a+b))
}
sigm1 = Vectorize(function(a=-1:1,b=-1:1,x){
outer(a,b,sigm,x)
},SIMPLIFY = FALSE)
Now, sigm1(x=1:3) gives the required output
[[1]]
[,1] [,2] [,3]
[1,] 0.1353353 0.3678794 1.000000
[2,] 0.3678794 1.0000000 2.718282
[3,] 1.0000000 2.7182818 7.389056
[[2]]
[,1] [,2] [,3]
[1,] 0.04978707 0.1353353 0.3678794
[2,] 0.36787944 1.0000000 2.7182818
[3,] 2.71828183 7.3890561 20.0855369
[[3]]
[,1] [,2] [,3]
[1,] 0.01831564 0.04978707 0.1353353
[2,] 0.36787944 1.00000000 2.7182818
[3,] 7.38905610 20.08553692 54.5981500
The only draw back with this code snippet is I am using the default values of a=-1:1 and b=-1:1. When I try to pass the same during function calling, it goes haywire. E.g.
sigm1(-1:1,-1:1,1:3)
[[1]]
[,1]
[1,] 0.1353353
[[2]]
[,1]
[1,] 1
[[3]]
[,1]
[1,] 54.59815
I am unable to figure out why passing the arguments is making this difference in output.
In this case, you should only vectorize the variable x.
sigm1 = Vectorize(function(a=-1:1,b=-1:1,x){
outer(a,b,sigm,x)}, vectorize.args = "x" ,SIMPLIFY = FALSE)
Then running sigm1(-1:1,-1:1,1:3) will gives the result you want.
We can just use lapply and don't need Vectorize at all:
lapply(x, function(x) outer(a, b, sigm, x = x))
giving:
[[1]]
[,1] [,2] [,3]
[1,] 0.1353353 0.3678794 1.000000
[2,] 0.3678794 1.0000000 2.718282
[3,] 1.0000000 2.7182818 7.389056
[[2]]
[,1] [,2] [,3]
[1,] 0.04978707 0.1353353 0.3678794
[2,] 0.36787944 1.0000000 2.7182818
[3,] 2.71828183 7.3890561 20.0855369
[[3]]
[,1] [,2] [,3]
[1,] 0.01831564 0.04978707 0.1353353
[2,] 0.36787944 1.00000000 2.7182818
[3,] 7.38905610 20.08553692 54.5981500

Getting different correlation values for the same combination of vectors

why am I getting different correlations for the same combination below?
> cor(finalDB[2:6],use="complete.obs")
rocky1Rating rocky2Rating rocky3Rating rocky4Rating rocky5Rating
rocky1Rating 1.0000000 ***0.6476523*** 0.5435555 0.4964198 0.3483168
rocky2Rating 0.6476523 1.0000000 0.7507204 0.6653651 0.5288312
rocky3Rating 0.5435555 0.7507204 1.0000000 0.7284123 0.5897088
rocky4Rating 0.4964198 0.6653651 0.7284123 1.0000000 0.6006595
rocky5Rating 0.3483168 0.5288312 0.5897088 0.6006595 1.0000000
> cor(finalDB[2],finalDB[3],use = "complete.obs")
rocky2Rating
rocky1Rating ***0.6011554***
The problem is likely NA values in your data set. When you set use="complete.obs" and you apply that to more than two columns, it only uses rows where all of those columns are not missing. If you only wanted to skip missing values for the unique pairs of columns, set use="pairwise.complete.obs". For example
set.seed(15)
mm<-matrix(runif(6*6), nrow=6)
mm[cbind(4:6, 1:3)]<-NA
cor(mm, use="complete.obs")
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 1.000000000 0.7577650 0.41079822 0.004065102 -0.9221867 0.86947546
# [2,] 0.757764997 1.0000000 -0.28363801 -0.649441771 -0.4464391 0.98119111
# [3,] 0.410798223 -0.2836380 1.00000000 0.913388689 -0.7314382 -0.09319206
# [4,] 0.004065102 -0.6494418 0.91338869 1.000000000 -0.3904905 -0.49043755
# [5,] -0.922186730 -0.4464391 -0.73143818 -0.390490510 1.0000000 -0.61077597
# [6,] 0.869475459 0.9811911 -0.09319206 -0.490437552 -0.6107760 1.00000000
cor(mm, use="pairwise.complete.obs")
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 1.0000000 0.70156571 0.50955114 -0.2663486 -0.7637746 0.7643575
# [2,] 0.7015657 1.00000000 -0.01542302 -0.2882218 -0.5666432 0.1206862
# [3,] 0.5095511 -0.01542302 1.00000000 0.8922900 -0.8904275 -0.5660903
# [4,] -0.2663486 -0.28822185 0.89229002 1.0000000 -0.4693979 -0.7574680
# [5,] -0.7637746 -0.56664323 -0.89042748 -0.4693979 1.0000000 0.2974870
# [6,] 0.7643575 0.12068622 -0.56609027 -0.7574680 0.2974870 1.0000000
cor(mm[,1], mm[,2], use="complete.obs")
# [1] 0.7015657
Notice how the last two results match up. Read the ?cor help page for more information.

Replacing Zero and Infinite Values for the Value of the First column

n the matrix example below (Stocks Return) :
IBOV PETR4 VALE5 ITUB4 BBDC4 PETR3
[1,] -0.03981646 -0.027412907 -0.051282051 -0.05208333 -0.047300526 -0.059805285
[2,] -0.03000415 -0.030534351 -0.046332046 -0.03943116 -0.030090271 -0.010355030
[3,] -0.02241318 -0.026650515 0.000000000 -0.04912517 -0.077559462 0.005231689
[4,] -0.05584830 -0.072184194 -0.066126856 -0.04317056 -0.066704036 0.000000000
[5,] 0.01196833 -0.004694836 0.036127168 -0.00591716 -0.006006006 Inf
[6,] 0.02039587 0.039083558 0.009762901 0.01488095 0.024169184 0.011783189
I would like to replace the 0 (Zeros) and Inf values for the values of the same row in the first column.
Here's a sample matrix
set.seed(15)
stocks<-matrix(rnorm(3*5), nrow=3)
stocks[cbind(c(2,3,1),c(4,4,2))] <- 0
stocks[2,2] <- Inf
stocks
# [,1] [,2] [,3] [,4] [,5]
# [1,] 0.2588229 0.000000 0.0227882 -1.075001 0.1655543
# [2,] 1.8311207 Inf 1.0907732 0.000000 -1.2427850
# [3,] -0.3396186 -1.255386 -0.1321224 0.000000 1.45928777
Now we can find the bad values, and then replace them with the values in the first column of the same row by using matrix indexing and the row() function to find the correct row.
bad <- stocks==0 | is.infinite(stocks)
stocks[bad] <- stocks[row(bad)[bad], 1]
stocks
# [,1] [,2] [,3] [,4] [,5]
# [1,] 0.2588229 0.2588229 0.0227882 -1.0750013 0.1655543
# [2,] 1.8311207 1.8311207 1.0907732 1.8311207 -1.2427850
# [3,] -0.3396186 -1.2553858 -0.1321224 -0.3396186 1.4592877

Passing more than 2 vectors in R [duplicate]

This question already has answers here:
Trying to pass more than 2 vectors to a function in R
(2 answers)
Closed 5 years ago.
I want to compute e^(ax+b) over a=-1:1 and b=-1:1 for various values of X. I want the output in the form a list of 5 elements. Each element in the list is 3X3 Matrix.
I did achieve this using Outer and Vectorize.
sigm = function(a=0,b=0,x){
return(exp(x*a+b))
}
sigm1 = Vectorize(function(a=-1:1,b=-1:1,x){
outer(a,b,sigm,x)
},SIMPLIFY = FALSE)
Now, sigm1(x=1:3) gives the required output
[[1]]
[,1] [,2] [,3]
[1,] 0.1353353 0.3678794 1.000000
[2,] 0.3678794 1.0000000 2.718282
[3,] 1.0000000 2.7182818 7.389056
[[2]]
[,1] [,2] [,3]
[1,] 0.04978707 0.1353353 0.3678794
[2,] 0.36787944 1.0000000 2.7182818
[3,] 2.71828183 7.3890561 20.0855369
[[3]]
[,1] [,2] [,3]
[1,] 0.01831564 0.04978707 0.1353353
[2,] 0.36787944 1.00000000 2.7182818
[3,] 7.38905610 20.08553692 54.5981500
The only draw back with this code snippet is I am using the default values of a=-1:1 and b=-1:1. When I try to pass the same during function calling, it goes haywire. E.g.
sigm1(-1:1,-1:1,1:3)
[[1]]
[,1]
[1,] 0.1353353
[[2]]
[,1]
[1,] 1
[[3]]
[,1]
[1,] 54.59815
I am unable to figure out why passing the arguments is making this difference in output.
You could use sapply to create your vectorized function
sigm = function(a, b, x){
return(lapply(x, function(xx) sapply(b, function(bb)
sapply(a, function(aa) exp(xx*aa+bb)))))
}
sigm(a = -1:1, b = -1:1, x = 1:3)
#[[1]]
# [,1] [,2] [,3]
#[1,] 0.1353353 0.3678794 1.000000
#[2,] 0.3678794 1.0000000 2.718282
#[3,] 1.0000000 2.7182818 7.389056
#[[2]]
# [,1] [,2] [,3]
#[1,] 0.04978707 0.1353353 0.3678794
#[2,] 0.36787944 1.0000000 2.7182818
#[3,] 2.71828183 7.3890561 20.0855369
#[[3]]
# [,1] [,2] [,3]
#[1,] 0.01831564 0.04978707 0.1353353
#[2,] 0.36787944 1.00000000 2.7182818
#[3,] 7.38905610 20.08553692 54.5981500

Resources