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
Related
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.
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.
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
library(magrittr)
library(dplyr)
V1 <- c("A","A","A","A","A","A","B","B","B","B", "B","B","C","C","C","C","C","C","D","D","D","D","D","D","E","E","E","E","E","E")
V2 <- c("A","B","C","D","E","F","A","B","C","D","E","F","A","B","C","D","E","F","A","B","C","D","E","F","A","B","C","D","E","F")
cor <- c(1,0.8,NA,NA,NA,NA,0.8,1,NA,NA,NA,NA,NA,NA,1,0.8,NA,NA,NA,NA,0.8,1,NA,NA,NA,NA,NA,NA,1,0.9)
df <- data.frame(V1,V2,cor)
# exclude rows where cor=NA
df <- df[complete.cases(df)==TRUE,]
This is the full data frame, cor=NA represents a correlation smaller than 0.8
df
V1 V2 cor
1 A A 1.0
2 A B 0.8
7 B A 0.8
8 B B 1.0
15 C C 1.0
16 C D 0.8
21 D C 0.8
22 D D 1.0
29 E E 1.0
30 E F 0.9
In the above df, F is not in V1, meaning that F is not of interest
so here I remove rows where V2=F (more generally, V2 equals to value that is not in V1)
V1.LIST <- unique(df$V1)
df.gp <- df[which(df$V2 %in% V1.LIST),]
df.gp
V1 V2 cor
1 A A 1.0
2 A B 0.8
7 B A 0.8
8 B B 1.0
15 C C 1.0
16 C D 0.8
21 D C 0.8
22 D D 1.0
29 E E 1.0
So now, df.gp is the dataset I need to work on
I drop the unused level in V2 (which is F in the example)
df.gp$V2 <- droplevels(df.gp$V2)
I do not want to exclude the autocorrelated variables, in case some of the V1 are not correlated with others, and I would like to put each of them in a separated group
By looking at the cor, A and B are correlated, C and D are correalted, and E belongs to a group by itself.
Therefore, the example here should have three groups.
The way I see this, you may have complicated things by working your data straight into a data.frame. I took the liberty of transforming it back to a matrix.
library(reshape2)
cormat <- as.matrix(dcast(data = df,formula = V1~V2))[,-1]
row.names(cormat) <- colnames(cormat)[-length(colnames(cormat))]
cormat
After I had your correlation matrix, it is easy to see which indices or non NA values are shared with other variables.
a <- apply(cormat, 1, function(x) which(!is.na(x)))
a <- data.frame(t(a))
a$var <- row.names(a)
row.names(a) <- NULL
a
X1 X2 var
1 1 2 A
2 1 2 B
3 3 4 C
4 3 4 D
5 5 6 E
Now either X1 or X2 determines your unique groupings.
Edited by cyrusjan:
The above script is a possible solution when assuming we already select the rows in with cor >= a, where a is a threshold taken as 0.8 in the above question.
Contributed by alexis_laz:
By using cutree and hclust, we can set the threshold in the script (i.e. h=0.8) as blow.
cor.gp <- data.frame(cor.gp =
cutree(hclust(1 - as.dist(xtabs(cor ~ V1 + V2, df.gp))), h = 0.8))
In standard functional programming, Map takes a list l and a function F and returns a new list with F applied to every element. As an example consider:
F(x) = x^2 and the list l = [1, 2, 3, 4, 5]
Map(f, l) would produce the list: [1, 4, 9, 16, 25]
I would like to use this notion of Map on an R dataframe. I would like my function F(x) to compute x / rowSum(row that x belongs to in the dataframe).
Consider the data frame given by:
df <- data.frame()
for(i in 1:5)
{
df <- rbind(df, c(i, i+1, i+2, i+3, i+4))
}
colnames(df) <- c("a", "b", "c", "d", "e")
Which gives:
a b c d e
1 1 2 3 4 5
2 2 3 4 5 6
3 3 4 5 6 7
4 4 5 6 7 8
5 5 6 7 8 9
I would like Map(F, df) to produce:
[,1] [,2] [,3] [,4] [,5]
v1 0.06666667 0.1333333 0.2 0.2666667 0.3333333
v2 0.10000000 0.1500000 0.2 0.2500000 0.3000000
v3 0.12000000 0.1600000 0.2 0.2400000 0.2800000
v4 0.13333333 0.1666667 0.2 0.2333333 0.2666667
v5 0.14285714 0.1714286 0.2 0.2285714 0.2571429
which is a dataframe where F is applied to every entry x in df.
The only hard part is figuring out how to write F:
F <- function(x) x / rowSum( row in which x belongs to in dataframe)
Map(F, df)
How do I write F
EDIT Here is an iterative solution:
pStat <- data.frame()
for(i in 1: 5)
{
v <- df[i,] / rowSums(df[i,])
pStates <- rbind(pStates, v)
}
R's recycling rules work out of the box
df / rowSums(df)
A data.frame is a (column-oriented) list of equal-length vectors (try df[[2]], for instance, or str(df)), so Map(F, df) is acting as in other functional languages by applying F to each column. The use of rowSums implies that the data are all numeric; it is often appropriate and efficient to then use a matrix, where recycling still works out of the box.
m <- as.matrix(df)
m / rowSums(m)
One could use a closure (e.g., a function that returns a function) to provide constant arguments (rowSums(df)) to a (inefficient) Map solution that acts explicitly on each column
Ffactory <- function(df) { r = rowSums(df); function(x) x / r }
mapped <- Map(Ffactory(df), df)
remembering to coerce the list to a data frame
as.data.frame(mapped)