I converted a distance matrix to a two column data.frame, I want to filter out the "diagonals" and ">0" values, keeping identical objects.
I have a distance matrix like
mat<-c(0,0.5,0,0.5,0,0.3,0,0.3,0)
dim(mat)<-c(3,3)
rownames(mat)<-c("A","B","C")
colnames(mat)<-c("A","B","C")
I tried
df = as.data.table(mat)
df1 <- stack(df)
setDT(df1)
df1[, pp := colnames(df)]
setkey(df1, values)
Which gives
values ind pp
1: 0.0 A A
2: 0.0 A C
3: 0.0 B B
4: 0.0 C A
5: 0.0 C C
6: 0.3 B C
7: 0.3 C B
8: 0.5 A B
9: 0.5 B A
What I need:
values ind pp
1: 0.0 A C
Here is one way to do it :
mat <- c(1,0.5,0,0.5,1,0.3,0,0.3,1)
dim(mat) <- c(3,3)
rownames(mat) <- c("A","B","C")
colnames(mat) <- c("A","B","C")
cond <- mat == 0 & upper.tri(mat, FALSE)
pos <- which(cond, arr.ind = TRUE)
data.frame(values = mat[pos], ind = rownames(mat)[pos[,1]], pp = rownames(mat)[pos[,2]])
cond is a boolean matrix of your condition, values equals to 0, not diagnonal and upper triangular matrix to remove duplicated index of the symetric matrix.
Related
Here is my data table:
A B C
A 1 0.8 0.2
B 0.8 1 0.3
C 0.2 0.3 1
I am trying to get the unique pairs of row names and column names based on the entries. For example, if I am looking at > 0.5, my output would be:
A B 0.8
If I am looking at < 0.5, my output would be:
B C 0.3
A C 0.2
This is a classical melt situation (though it needs some seasoning with upper or lower.tri)
dat <- read.table(text=
" A B C
A 1 0.8 0.2
B 0.8 1 0.3
C 0.2 0.3 1
", header=TRUE )
dat[ !upper.tri(dat) ] <- NA
dat <- as.data.frame( dat )
dat <- tibble::rownames_to_column( dat, "V1" )
setDT(dat)
use.this <- melt( dat, id.vars="V1", variable.name="V2" )[ !is.na(value) ]
use.this[ value < .5 ]
use.this[ value > 0.5 ]
It looks like this:
> use.this[ value < .5 ]
V1 V2 value
1: A C 0.2
2: B C 0.3
> use.this[ value > .5 ]
V1 V2 value
1: A B 0.8
In base R, using which with arr.ind = TRUE to get the row and column numbers that meet the condition.
df[lower.tri(df, diag = TRUE)] <- NA
mat <- which(df < 0.5, arr.ind = TRUE)
data.frame(rowname = rownames(df)[mat[, 1]],
colname = colnames(df)[mat[, 2]],
value = df[mat])
# rowname colname value
#1 A C 0.2
#2 B C 0.3
data
df <- structure(list(A = c(1, 0.8, 0.2), B = c(0.8, 1, 0.3), C = c(0.2,
0.3, 1)), class = "data.frame", row.names = c("A", "B", "C"))
Here is another option:
M <- matrix(c(1,0.8,0.2,0.8,1,0.3,0.2,0.3,1), nrow=3L,
dimnames=list(LETTERS[1:3], LETTERS[1:3]))
allDT <- data.table(rn=rep(rownames(M), nrow(M)),
cn=rep(colnames(M), each=ncol(M)),
val=as.vector(M))
DT <- unique(allDT[, .(val=val), .(rn=pmin(rn, cn), cn=pmax(rn, cn))])
DT[val<0.5]
The question has been tagged data.table. So, here is a simple solution which uses only data.table syntax. In addition, it suggests lookup functions (EDIT: in 3 different flavours) which require less keystrokes.
library(data.table)
wide <- fread(" A B C
A 1 0.8 0.2
B 0.8 1 0.3
C 0.2 0.3 1")
long <- melt(wide, id.var = "V1", variable.name = "V2",
variable.factor = FALSE)[V1 < V2]
long
V1 V2 value
1: A B 0.8
2: A C 0.2
3: B C 0.3
Note that the upper triangular part of wide is picked after reshaping to long format by subsetting [V1 < V2] which ensures that only unique pairs are considered.
long can be queried by subsetting, e.g.,
long[value < 0.5]
V1 V2 value
1: A C 0.2
2: B C 0.3
long[value > 0.5]
V1 V2 value
1: A B 0.8
lookup function
long can be queried by defining a lookup function:
l <- function(cond) eval(parse(text = paste0("long[value", cond, "]")))
which can be called, e.g.,
l("< .5")
V1 V2 value
1: A C 0.2
2: B C 0.3
l("> .5")
V1 V2 value
1: A B 0.8
l("== .3")
V1 V2 value
1: B C 0.3
EDIT: lookup function with 2 arguments
Alternatively, the lookup function can be defined to allow for 2 arguments, one for the comparision operator, one for the numerical values:
l2 <- function(op, v) long[do.call(op, list(value, v))]
l2("%between%", c(0.25, 0.95))
V1 V2 value
1: A B 0.8
2: B C 0.3
Or, with the new interface for programming on data.table (available with data.table development version 1.14.1):
l3 <- function(op, v) long[op(value, v), env = list(op = as.name(op), v = v)]
l3("%in%", c(0.2, 0.3))
V1 V2 value
1: A C 0.2
2: B C 0.3
I have 3 vectors
a = c(3,7)
b = c(4,6)
c = c(2,6)
I would like to make the union of these 3 sets. I could use the union() function but "convex" union requires that the vector c is removed from the union because it is dominated by a, which is higher for the two elements.
Any idea of a simple way to do it?
If each row of m is a pair then which.nondominated(-t(m)) gives the row numbers of the rows not dominated by some other row. The code is written in C so it should be fast.
library(ecr)
m <- rbind(a, b, c) # input data
ix <- which.nondominated(-t(m)) # 1, 2
mm <- m[ix, ]
mm
## [,1] [,2]
## a 3 7
## b 4 6
There are no duplicates in this example but if there could be and if you also wanted to remove them then:
unique(mm)
or
mm[!duplicated(mm), ]
This will work in the cases mentioned above in the comments.
a = c(3,7)
b = c(4,6)
c = c(2,6)
d = c(3.5,6.5)
my_fun <- function(A){
B <- matrix(NA,ncol=ncol(A))
for(i in 1:nrow(A)){
include <- !any(apply(A[-i,],1,function(x){all(A[i,] < x)}))
if(include){
B <- rbind(B,A[i,])
}
}
na.omit(B)
}
A <- rbind(a,b,c,d)
my_fun(A)
[,1] [,2]
[1,] 3.0 7.0
[2,] 4.0 6.0
[3,] 3.5 6.5
I think the solution by #G. Grothendieck is so far the best. Here is another solution with base R.
Assuming you are using a data frame df which consists of a,b,c and d, i.e,
a = c(3,7)
b = c(4,6)
c = c(2,6)
d = c(3.5,6.5)
df <- data.frame(t(data.frame(a,b,c,d)))
> df
X1 X2
a 3.0 7.0
b 4.0 6.0
c 2.0 6.0
d 3.5 6.5
then maybe the following code can help you to make convex union
l <- combn(df[,1],2,diff)
b <- combn(df[,2],2,diff)
idx <- combn(seq(nrow(df)),2)
m <- df[unique(as.vector(idx[,l*b<0])),]
> m
X1 X2
a 3.0 7.0
b 4.0 6.0
d 3.5 6.5
I have a data frame of correlations which looks something like this (although there are ~15,000 rows in my real data)
phen1<-c("A","B","C")
phen2<-c("B","C","A")
cors<-c(0.3,0.7,0.8)
data<-as.data.frame(cbind(phen1, phen2, cors))
phen1 phen2 cors
1 A B 0.3
2 B C 0.7
3 C A 0.8
This was created externally and read into R and I want to convert this data frame into a correlation matrix with phen1 and 2 as the labels for rows and columns of this matrix. I have only calculated this for either the lower or upper triangle and I don't have the 1's for the Diagnonal. So I would like the end results to be a full correlation matrix but a first step would probably be to create the lower/upper triangle and then convert to a full matrix I think. I'm unsure how to do either step of this.
Also, the results may not be in an intuitive order, but I'm not sure if this matters, but ideally I would like a way to do this which uses the labels in phen1 and phen 2 to make sure the matrix has the correct values in the correct place if that makes sense?
Essentially for this, I would want something like this as an end result:
A B C
A 1 0.3 0.8
B 0.3 1 0.7
C 0.8 0.7 1
Here is another one in base R where we create a symmetrical dataframe same as data but with columns inverted for phen1 and phen2. Then we use xtabs to get a correlation matrix and set diagonal to 1.
data1 <- data.frame(phen1 = data$phen2, phen2 = data$phen1, cors = data$cors)
df <- rbind(data, data1)
df1 <- as.data.frame.matrix(xtabs(cors ~ ., df))
diag(df1) <- 1
df1
# A B C
#A 1.0 0.3 0.8
#B 0.3 1.0 0.7
#C 0.8 0.7 1.0
data
phen1<-c("A","B","C")
phen2<-c("B","C","A")
cors<-c(0.3,0.7,0.8)
data<- data.frame(phen1, phen2, cors)
I think there must be an elegant way to do it, however, here is a dplyr and tidyr possibility:
data %>%
spread(phen1, cors) %>%
rename(phen = "phen2") %>%
bind_rows(data %>%
spread(phen2, cors) %>%
rename(phen = "phen1")) %>%
group_by(phen) %>%
summarise_all(~ ifelse(all(is.na(.)), 1, first(na.omit(.))))
phen A B C
<chr> <dbl> <dbl> <dbl>
1 A 1 0.3 0.8
2 B 0.3 1 0.7
3 C 0.8 0.7 1
You can use the Matrix package for this. What you have is a sparse representation of the data and you want to turn this into a dense (redundant) matrix.
data <- data.frame(phen1, phen2, cors)
inds <- cbind(as.integer(data$phen1), as.integer(data$phen2))
inds <- t(apply(inds, 1, sort))
library(Matrix)
res <- sparseMatrix(i = inds[,1],
j = inds[,2],
x = data$cors,
symmetric = TRUE)
#3 x 3 sparse Matrix of class "dsCMatrix"
#
#[1,] . 0.3 0.8
#[2,] 0.3 . 0.7
#[3,] 0.8 0.7 .
res <- as.matrix(res)
diag(res) <- 1
dimnames(res) <- list(sort(data$phen1), sort(data$phen2))
res
# A B C
#A 1.0 0.3 0.8
#B 0.3 1.0 0.7
#C 0.8 0.7 1.0
Here's another option.
First reshape data from long to wide and convert to a matrix. You have different options to do that (reshape2, tidyr, etc.); here I use tidyr::spread.
library(tidyverse)
mat <- data %>% spread(phen2, cors) %>% column_to_rownames("phen1") %>% as.matrix()
We then fill the missing NA values from the upper and lower triangular matrix respectively, and fill the diagonal with 1.
mat[lower.tri(mat)] <- mapply(sum, mat[lower.tri(mat)], mat[upper.tri(mat)], na.rm = T)
mat[upper.tri(mat)] <- mat[lower.tri(mat)]
diag(mat) <- 1
mat
# A B C
#A 1.0 0.3 0.8
#B 0.3 1.0 0.7
#C 0.8 0.7 1.0
You can use reshape library.
library(reshape)
data <- melt(data)
your_mat <- cast(data, phen1 ~ phen2 )
Output:
phen1 A B C
1 A <NA> 0.3 <NA>
2 B <NA> <NA> 0.7
3 C 0.8 <NA> <NA>
The reason you will NAs because you have many missing combination from your input table. For avoiding this you need an input table like this:
phen1 phen2 cors
1 A B 0.3
2 B C 0.7
3 C A 0.8
4 A C 0.8
5 B A 0.3
6 C B 0.7
7 A A 1.0
8 B B 1.0
9 C C 1.0
Plenty of solutions already, but I'll throw in another way. Note: I'm setting up the data so that cors is numeric rather than a factor in your original data frame.
data <- data.frame(phen1, phen2, cors)
Then we can expand the data frame with missing combinations and then uses reshape2::acast() to convert the data to wide format.
library(tidyverse)
library(reshape2)
data %>%
select(phen1 = phen2, phen2 = phen1, cors) %>%
bind_rows(data) %>%
acast(phen1 ~ phen2, fill = 1)
acast handily lets you fill in the missing values with some other specified value, in this case 1.
Also, check out the corrr package, which may be able to do this more neatly.
Here is a function that I wrote:
long2cormat <- function(xlong, x = "x", y = "y", r = "r") {
# Takes some inspiration from https://stackoverflow.com/a/57904948/180892
xlong <- xlong[,c(x, y, r)]
names(xlong) <- c("x", "y", "r")
data1 <- data.frame(x = xlong$x, y = xlong$y, r = xlong$r)
data2 <- data.frame(x = xlong$y, y = xlong$x, r = xlong$r)
df <- rbind(data1, data2)
uv <- unique(c(df$x, df$y))
df1 <- matrix(NA, nrow = length(uv), ncol = length(uv), dimnames = list(uv, uv))
for (i in seq(nrow(df))) df1[df$x[i], df$y[i]] <- df$r[i]
diag(df1) <- 1
df1
}
To run it do the following:
xlong <- data.frame(phen1 = c("A","B","C"),
phen2 = c("B","C","A"),
cors = c(0.3,0.7,0.8))
long2cormat(xlong, "phen1", "phen2", "cors")
Importantly, for my own use cases, it leaves missing correlations as NA.
Let's say I have the following data.table:
DT <- setDT(data.frame(id = 1:10, LETTERS = LETTERS[1:10],
letters = letters[1:10]))
##+ > DT
## id LETTERS letters
## 1: 1 A a
## 2: 2 B b
## 3: 3 C c
## 4: 4 D d
## 5: 5 E e
## 6: 6 F f
## 7: 7 G g
## 8: 8 H h
## 9: 9 I i
## 10: 10 J j
and I want to find the row and column numbers of the letter 'h' (which are 8 and 3). How would I do that?
DT[, which(.SD == "h", arr.ind = TRUE)]
# row col
# [1,] 8 3
EDIT:
Trying to take into account Michael's points:
str_idx = which(sapply(DT, function(x) is.character(x) || is.factor(x)))
idx <- DT[, which(as.matrix(.SD) == "h", arr.ind = TRUE), .SDcols = str_idx]
idx[, "col"] <- chmatch(names(str_idx)[idx[, "col"]], names(DT))
idx
# row col
# [1,] 8 3
Depends on the exact format of your desired output.
# applying to non-string columns is inefficient
str_idx = which(sapply(DT, is.character))
# returns a list as long as str_idx with two elements appropriately named
lapply(str_idx, function(jj) list(row = which(DT[[jj]] == 'h'), col = jj))
It should also be possible to melt the string columns your table to avoid looping.
I have a vector with values which distribution is unknown and i want to create another vector with the probabilities of the values i have.
eg.
I have
v <- c(e1, e2, ... , ei)
and i want to create
p <- c(P(e1), P(e2), ... , P(ei))
How can i do this in R?
As you want to create a vector the same length as the vector of values, you could do something like:
p <- sapply(v, function(x) length(which(x == v))/length(v))
Example using letters as values
set.seed(123)
v = sample(letters[1:4], 10, replace = TRUE)
p <- sapply(v, function(x) length(which(x == v))/length(v))
p
#> b d b d d a c d c b
#> 0.3 0.4 0.3 0.4 0.4 0.1 0.2 0.4 0.2 0.3