Let's say I have two or more vectors with to or more elements (single factor) each, e.g.
v1 = c("a", "a", "a")
v2 = c("b", "b")
What I want to do is to merge all vectors and distribute the elements for each group as equally as possible.
For the simple example above there would be a single solution:
c("a", "b", "a", "b", "a")
If v1 = c("a", "a", "a", "a") any of these
c("a", "b", "a", "b", "a", "a")
c("a", "b", "a", "a", "b", "a")
c("a", "a", "b", "a", "b", "a")
would be the best solution. Is there a built-in function that can do this? Any ideas how to implement it?
This would work for two vectors.
v1 = c("a", "a", "a")
v2 = c("b", "b")
distribute_equally <- function(v1, v2) {
v3 <- c(v1, v2)
tab <- sort(table(v3))
c(rep(names(tab), min(tab)), rep(names(tab)[2], diff(range(tab))))
}
distribute_equally(v1, v2)
#[1] "b" "a" "b" "a" "a"
distribute_equally(c('a', 'a'), c('b', 'b'))
#[1] "a" "b" "a" "b"
Thinking of the problem in terms of experimental design optimization, we can get a general solution using the MaxProQQ function in the MaxPro package.
Each position in the merged vector can be thought of as coming from a discrete quantitative factor, and the factors from your v1, v2, etc. can be thought of as qualitative factors. Here's some example code (MaxProQQ takes integer factors instead of characters, but you can convert it afterward):
library(MaxPro)
set.seed(1)
v1 <- rep(1, sample.int(10, 1))
v2 <- rep(2, sample.int(10, 1))
v3 <- rep(3, sample.int(10, 1))
v4 <- rep(4, sample.int(10, 1))
vComb <- c(v1, v2, v3, v4)
vMerge1234 <- MaxProQQ(cbind(1:length(vComb), sample(vComb, length(vComb))), p_nom = 1)$Design
vMerge1234 <- vMerge1234[order(vMerge1234[,1]),][,2]
> vMerge1234
[1] 4 3 4 2 4 3 4 1 2 4 3 4 2 4 3 1 4 3 2 4 1 3 4
Generate 100 samples, say, without replacement from c(v1, v2) giving m which is 5x100 with one column per sample. Then find the column for which the sum of the variances of the frequencies over each group is minimized. If there are more than two vectors just concatenate them in the line marked ## and the rest of the code stays the same.
set.seed(123)
v1 = c("a", "a", "a")
v2 = c("b", "b")
v <- c(v1, v2) ##
m <- replicate(100, sample(v))
varsum <- apply(m, 2, function(x) {
f <- factor(x, levels = unique(v))
sum(tapply(f, v, function(x) var(table(x))))
})
m[, which.min(varsum)]
## [1] "a" "a" "b" "b" "a"
Related
I have a data frame with two columns. The first one "V1" indicates the objects on which the different items of the second column "V2" are found, e.g.:
V1 <- c("A", "A", "A", "A", "B", "B", "B", "C", "C", "C", "C")
V2 <- c("a","b","c","d","a","c","d","a","b","d","e")
df <- data.frame(V1, V2)
"A" for example contains "a", "b", "c", and "d". What I am looking for is a three dimensional array with dimensions of length(unique(V2)) (and the names "a" to "e" as dimnames).
For each unique value of V1 I want all possible combinations of three V2 items (e.g. for "A" it would be c("a", "b", "c"), c("a", "b", "d", and c("b", "c", "d").
Each of these "three-item-co-occurrences" should be regarded as a coordinate in the three-dimensional array and therefore be added to the frequency count which the values in the array should display. The outcome should be the following array
ar <- array(data = c(0,0,0,0,0,0,0,1,2,1,0,1,0,2,0,0,2,2,0,1,0,1,0,1,0,
0,0,1,2,1,0,0,0,0,0,1,0,0,1,0,2,0,1,0,1,1,0,0,1,0,
0,1,0,2,0,1,0,0,1,0,0,0,0,0,0,2,1,0,0,0,0,0,0,0,0,
0,2,2,0,1,2,0,1,0,1,2,1,0,0,0,0,0,0,0,0,1,1,0,0,0,
0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0),
dim = c(5, 5, 5),
dimnames = list(c("a", "b", "c", "d", "e"),
c("a", "b", "c", "d", "e"),
c("a", "b", "c", "d", "e")))
I was wondering about the 3D symmetry of your result. It took me a while to understand that you want to have all permutations of all combinations.
library(gtools) #for the permutations
foo <- function(x) {
#all combinations:
combs <- combn(x, 3, simplify = FALSE)
#all permutations for each of the combinations:
combs <- do.call(rbind, lapply(combs, permutations, n = 3, r = 3))
#tabulate:
do.call(table, lapply(asplit(combs, 2), factor, levels = letters[1:5]))
}
#apply grouped by V1, then sum the results
res <- Reduce("+", tapply(df$V2, df$V1, foo))
#check
all((res - ar)^2 == 0)
#[1] TRUE
I used to use the crossjoin CJ() to retain the pairwise count of all combinations of two different V2 items
res <- setDT(df)[,CJ(unique(V2), unique(V2)), V1][V1!=V2,
.N, .(V1,V2)][order(V1,V2)]
This code creates a data frame res with three columns. V1 and V2 contain the respective items of V2 from the original data frame df and N contains the count (how many times V1 and V2 appear with the same value of V1 (from the original data frame df).
Now, I found that I could perform this crossjoin with three 'dimensions' as well by just adding another unique(V2) and adapting the rest of the code accordingly.
The result is a data frame with four columns. V1, V2, and V3 indicate the original V2 items and N again shows the number of mutual appearances with the same original V1 objects.
res <- setDT(df)[,CJ(unique(V2), unique(V2), unique(V2)), V1][V1!=V2 & V1 != V3 & V2 != V3,
.N, .(V1,V2,V3)][order(V1,V2,V3)]
The advantage of this code is that all empty combinations (those which do not appear at all) are not considered. It worked with 1,000,000 unique values in V1 and over 600 unique items in V2, which would have otherwise caused an extremely large array of 600 x 600 x 600
I would like to create a table or a new data frame that displays, for each row in the original data frame, how many times a specific value precedes another specific value. For example, if I have the following data frame:
x <- data.frame("Red" = c("a", "b", "a", "a", "c", "d"), "Blue" = c("b", "a", "b", "a", "b", "a"), "Green" = c("a", "a", "b", "a", "b", "a"))
and I want to know, for each color (Red, Blue, and Green) how many times the sequence "b", "a" occurs (i.e., how many times b precedes a in the sequence).
The correct answer would look something like this:
Color ba
1 Red 1
2 Blue 3
3 Green 2
here is one solution using stringr
library(stringr)
count_pair <- function(x, pattern) {
p <- paste(pattern, collapse = "")
s <- paste(x, collapse = "")
str_count(s, pattern = p)
}
z <- apply(x, 2, count_pair, pattern = c("b", "a"))
# Red Blue Green
# 1 3 2
# if you want the output in form of a data.frame you could run:
df <- as.data.frame(as.table(z))
# Var1 Freq
# 1 Red 1
# 2 Blue 3
# 3 Green 2
SEE UPDATE BELOW:
Given a data frame with two columns (x1, x2) representing pairs of objects, I would like to generate groups where all members of each group are paired with all other members in that group. Thus far, I have been able to generate groups by showing all items in x2 that are paired with each item in x1, but this leaves me with groups where a couple of members are only paired with one other group member. I'm having a hard time getting off the ground with this one... Thanks in advance for any help you may have. Please let me know if I should edit this post as I am new to Stack Overflow and new to R coding.
x1 <- c("A", "B", "B", "B", "C", "C", "D", "D", "D", "E", "E")
x2 <- c("A", "B", "C", "D", "B", "C", "B", "D", "E", "D", "E")
df <- data.frame(x1, x2)
I would like to go from this df, to an output that looks like df2.
group1 <- c("A")
group2 <- c("B", "C")
group3 <- c("B", "D")
group4 <- c("D", "E")
df2 <- data.frame(cbind.fill(group1, group2, group3, group4, fill = "NULL"))
UPDATE:
Given the following dataset....
x1 <- c("A", "B", "B", "B", "C", "C", "D", "D", "D", "E", "E", "B", "C", "F")
x2 <- c("A", "B", "C", "D", "B", "C", "B", "D", "E", "D", "E", "F", "F", "F")
df <- data.frame(x1, x2)
.... I would like to identify groups of x1/x2 where all objects within said group are connected to all other objects of that group.
This is what I have thus far (I'm sure this is riddled with best-practice errors, feel free to call them out. I'm eager to learn)...
n <- nrow(as.data.frame(unique(df$x1)))
RosterGuide <- as.data.frame(matrix(nrow = n , ncol = 1))
RosterGuide$V1 <- seq.int(nrow(RosterGuide))
RosterGuide$Object <- (unique(df$x1))
colnames(RosterGuide) <- c("V1","Object")
groups_frame <- matrix(, ncol= length(n), nrow = length(n))
for (loopItem in 1:nrow(RosterGuide)) {
object <- subset(RosterGuide$Object, RosterGuide$V1 == loopItem)
group <- as.data.frame(subset(df$x2, df$x1 == object))
groups_frame <- cbind.fill(group, groups_frame, fill = "NULL")
}
Groups <- as.data.frame(groups_frame)
Groups <- subset(Groups, select = - c(object))
colnames(Groups) <- RosterGuide$V1
This yields the data frame 'Groups'....
1 2 3 4 5 6
1 F D B B B A
2 NULL E D C C NULL
3 NULL NULL E F D NULL
4 NULL NULL NULL NULL F NULL
... which is exactly what I am looking for, except that if you look at the original df, objects F and D are never paired, rendering group 5 invalid. Also, objects B and E are never paired, rendering group 3 invalid. A valid output should look like this...
1 2 3 4 5
1 D B B B A
2 E D C C NULL
3 NULL NULL NULL F NULL
Question: is there some way that I can relate the groups listed above in the 'Groups' data frame to the original df to remove groups with invalid relationships? This really has me stumped.
For context: What I am really trying to do is group items based on pairwise connections derived from a network of nodes where not all nodes are connected.
Here is one way doing it in base R using apply and unique
df <- data.frame(x1, x2, stringsAsFactors = F)
df <- df[df$x1 != df$x2, ]
unique(t(apply(df, 1, sort)))
[,1] [,2]
3 "B" "C"
4 "B" "D"
9 "D" "E"
dplyr
df %>%
dplyr::filter(x1 != x2) %>%
dplyr::filter(!duplicated(paste(pmin(x1,x2), pmax(x1,x2), sep = "-")))
x1 x2
1 B C
2 B D
3 D E
data.table (there might be another better way)
library(data.table)
as.data.table(df)[, .SD[x1 != x2]][, .GRP, by = .(x1 = pmin(x1,x2), x2 = pmax(x1,x2))]
x1 x2 GRP
1: B C 1
2: B D 2
3: D E 3
I am a beginner in R. I have a dataframe in which there are two factor columns. One column is a company column, second is a product column. There are several missing values in product column and so I want to count the number of values in product column for each company (or each level of the company variable). I tried table, and count function in plyr package but they only seem to work with numeric variables. Please help!
Lets say the data frame looks like this:
df <- data.frame(company= c("A", "B", "C", "D", "A", "B", "C", "C", "D", "D"), product = c(1, 1, 2, 3, 4, 3, 3, NA, NA, NA))
So the output I am looking for is -
A 2
B 2
C 3
D 2
Thanks in advance!!
A dplyr solution.
df %>%
filter(!is.na(product)) %>%
group_by(company) %>%
count()
# A tibble: 4 × 2
comp n
<fctr> <int>
1 A 2
2 B 2
3 C 3
4 D 1
We can use rowsum from base R
with(df, rowsum(+!is.na(prod), comp))
Assuming your df is :
CASE 1) As give in question
Data for df:
options(stringsAsFactors = F)
comp <- c("A", "B", "C", "D", "A", "B", "C", "C", "D","D" )
prod <- c(1,1,2,3,4,3,3,1,NA,NA)
df <- data.frame(comp=comp,prod=prod)
Program:
df$prodflag <- !is.na(df$prod)
tapply(df$prodflag , df$comp,sum)
Output:
> tapply(df$prodflag , df$comp,sum)
A B C D
2 2 3 1
#########################################################################
CASE 2) In case stringsAsFactors is on and prod is in characters, even NAs are quoted as characters and marked as factors then you can do:
Data:
comp <- c("A", "B", "C", "D", "A", "B", "C", "C", "D","D" )
prod <- c("a","a","b","c","d","c","c","a","NA","NA")
df <- data.frame(comp=comp,prod=prod,stringsAsFactors = T)
Solution:
df$prodflag <- as.numeric(!as.character(df$prod)=="NA")
tapply(df$prodflag , df$comp,sum)
#########################################################################
CASE 3) In case the prod is a character and stringsAsFactors is on but NAs are not quoted then you can do:
Data:
comp <- c("A", "B", "C", "D", "A", "B", "C", "C", "D","D" )
prod <- c("a","a","b","c","d","c","c","a",NA,NA)
df <- data.frame(comp=comp,prod=prod,stringsAsFactors = T)
Solution:
df$prodflag <- as.numeric(!is.na(df$prod))
tapply(df$prodflag , df$comp,sum)
Moral of the story, we should understand our data and then we can the logic which best suits our need.
I'm trying to combine factor levels in a data.table & wondering if there's a data.table-y way to do so.
Example:
DT = data.table(id = 1:20, ind = as.factor(sample(8, 20, replace = TRUE)))
I want to say types 1,3,8 are in group A; 2 and 4 are in group B; and 5,6,7 are in group C.
Here's what I've been doing, which has been quite slow in the full version of the problem:
DT[ind %in% c(1, 3, 8), grp := as.factor("A")]
DT[ind %in% c(2, 4), grp := as.factor("B")]
DT[ind %in% c(5, 6, 7), grp := as.factor("C")]
Another approach, suggested by this related question, would I guess translate like so:
DT[ , grp := ind]
levels(DT$grp) = c("A", "B", "A", "B", "C", "C", "C", "A")
Or perhaps (given I've got 65 underlying groups and 18 aggregated groups, this feels a little neater)
DT[ , grp := ind]
lev <- letters(1:8)
lev[c(1, 3, 8)] <- "A"
lev[c(2, 4)] <- "B"
lev[5:7] <- "C"
levels(DT$grp) <- lev
Both of these seem unwieldy; does this seem like the appropriate way to do this in data.table?
For reference, I timed a beefed up version of this with 10,000,000 observations and some more subgroup/supergroup levels. My original approach is slowest (having to run all those logic checks is costly), the second the fastest, and the third a close second. But I like the readability of that approach better.
(Keying DT before searching speeds things up, but it only halves the gap vis-a-vis the latter two methods)
Update:
I recently learned of a much simpler way to re-associate factor levels from this question and a closer reading of ?levels. No merges, correspondence table, etc. necessary, just pass a named list to levels:
levels(DT$ind) = list(A = c(1, 3, 8), B = c(2, 4), C = 5:7)
Original Answer:
As suggested by #Arun we have the option of creating the correspondence as a separate data.table, then joining it to the original:
match_dt = data.table(ind = as.factor(1:12),
grp = as.factor(c("A", "B", "A", "B", "C", "C",
"C", "A", "D", "E", "F", "D")))
setkey(DT, ind)
setkey(match_dt, ind)
DT = match_dt[DT]
We can also do this in (what I consider to be) the more readable fashion like so (with marginal speed costs):
levels <- letters[1:12]
levels[c(1, 3, 8)] <- "A"
levels[c(2, 4)] <- "B"
levels[5:7] <- "C"
levels[c(9, 12)] <- "D"
levels[10] <- "E"
levels[11] <- "F"
match_dt <- data.table(ind = as.factor(1:12),
grp = as.factor(levels))
setkey(DT, ind)
setkey(match_dt, ind)
DT = match_dt[DT]