聚合直方图数据

Question

我有一些属性的直方图，不同的独特模型的一些‘东西’。当我做一个实验时，我发现了这些独特的模型中的多个。考虑到实验的整个样本集，我需要找到每个属性的直方图。

示例：

对于如下所示的数据框架df，有一堆id's，对于每个id，都有一组名为prop1、prop2等的属性。

set.seed(1)
df <- data.frame(id = sample(1:5, 6, replace = TRUE),
                     prop1 = rep(c("A", "B"), 3),
                     prop2 = sample(c(TRUE, FALSE), 6, replace = TRUE),
                     prop3=sample(3:6, 6, replace = TRUE))

> df
  id prop1 prop2 prop3
1  2     A FALSE     4
2  2     B  TRUE     4
3  3     A FALSE     6
4  1     B  TRUE     5
5  3     A FALSE     3
6  3     B FALSE     4

对于eqch唯一的id，计算每个属性的直方图，并将结果存储在列表l1中，列表l1根据每个id保存每个属性的直方图。

# Create histogram for each property
df[-1] <- lapply(df[-1], as.factor)
fun1 <- function(df, n){as.data.frame(t(sapply(split(df, df$id), function(i) 
                                                         prop.table(table(i[,n])))))}
l1 <- sapply(2:ncol(df), function(i)fun1(df, i))
names(l1) <- names(df[-1])

> l1
$prop1
          A         B
1 0.0000000 1.0000000
2 0.5000000 0.5000000
3 0.6666667 0.3333333

$prop2
  FALSE TRUE
1   0.0  1.0
2   0.5  0.5
3   1.0  0.0

$prop3
          3         4 5         6
1 0.0000000 0.0000000 1 0.0000000
2 0.0000000 1.0000000 0 0.0000000
3 0.3333333 0.3333333 0 0.3333333

下面我有一组新的ids，来自一个新的实验，有重复。我需要使用来自id's的参考数据计算整个l1集合中的每个属性的直方图。

一些id's可能不存在；一些id's可能不存在于原始df中，而l1可能存在于ids中--例如ids中的4不存在于l1中--然而，可以将它们从直方图计算中排除出来，但它们被捕获为包含排除id的数据格式，并对每个id排除。

ids <- sample(1:4, 7, replace = TRUE)
> ids
 [1] 2 3 1 3 3 2 4

更新：期望的输出--我把它显示为列表--任何其他更合适的数据结构都可以使用。

> l2
$prop1
      A     B
1 0.500 0.500

$prop2
    FALSE    TRUE
1   0.667  0.333

$prop3
      3     4     5     6
1 0.167 0.500 0.167 0.167 

R基方案优先。

Update：澄清如何计算输出。

在ids中计数- 1，2，2，3，3和1 4。由于我们没有任何关于4的数据，所以有用的ids是1、2和3，它们之间的总计数为6 ids。

对于prop1，可以按以下方式计算ids的聚集直方图

A = (1*0.0 + 2*0.5  + 3*0.6667)/6 = 0.5
B = (1*1.0 + 2*0.5  + 3*0.3333)/6 = 0.5

Answer 1

我为您提供了一个解决方案，它确实涉及到其他包(dplyr和tidyr)。因为我正在重塑(融化)你在列表中生成的数据。之后，我将数据扩展到一个很好的data.frame中。当然，您也可以使用数据的规范化版本。(df)在function(x)中。

library(dplyr)
library(tidyr)

res <- do.call(rbind,
               lapply(ids, function(id) do.call(cbind,
                                                lapply(names(l1),function(x) {
  df <- l1[[x]] %>% rownames_to_column("id")
  df <- df[df$id == id,] %>% gather(key, value, -id) 
  if(nrow(df) > 0){
    df[,'key'] <- paste0(x,'.',df[,'key'])
    df <- df %>% spread(key,value)
  }
  df
}))
)
)

结果：

> res
  id   prop1.A   prop1.B id prop2.FALSE prop2.TRUE id   prop3.4   prop3.5 prop3.6
1  2 0.6666667 0.3333333  2   0.6666667  0.3333333  2 0.3333333 0.6666667       0
2  3 1.0000000 0.0000000  3   1.0000000  0.0000000  3 0.0000000 0.0000000       1
3  2 0.6666667 0.3333333  2   0.6666667  0.3333333  2 0.3333333 0.6666667       0
4  2 0.6666667 0.3333333  2   0.6666667  0.3333333  2 0.3333333 0.6666667       0
5  2 0.6666667 0.3333333  2   0.6666667  0.3333333  2 0.3333333 0.6666667       0

您也可以在没有prop.table函数的情况下实现这一点，只有dplyr，这是一个更整洁的解决方案。

propsum <- df %>% gather(key,value,-id) %>% mutate(n = 1) %>%
  complete(nesting(key,value),id, fill=list(n = 0)) %>%
  group_by(id, key, value) %>%
  summarise(n = sum(n)) %>%
  group_by(id, key) %>%
  mutate(p = n/sum(n)
         ,col = paste0(key,'.',value)) %>% 
  ungroup() %>%
  select(id, col, p) %>%
  spread(col,p)

propsum[match(ids,propsum$id),]

结果：

# A tibble: 10 × 8
      id   prop1.A   prop1.B prop2.FALSE prop2.TRUE   prop3.4   prop3.5 prop3.6
   <int>     <dbl>     <dbl>       <dbl>      <dbl>     <dbl>     <dbl>   <dbl>
1      2 0.6666667 0.3333333   0.6666667  0.3333333 0.3333333 0.6666667       0
2     NA        NA        NA          NA         NA        NA        NA      NA
3     NA        NA        NA          NA         NA        NA        NA      NA
4     NA        NA        NA          NA         NA        NA        NA      NA
5      3 1.0000000 0.0000000   1.0000000  0.0000000 0.0000000 0.0000000       1
6     NA        NA        NA          NA         NA        NA        NA      NA
7      2 0.6666667 0.3333333   0.6666667  0.3333333 0.3333333 0.6666667       0
8      2 0.6666667 0.3333333   0.6666667  0.3333333 0.3333333 0.6666667       0
9     NA        NA        NA          NA         NA        NA        NA      NA
10     2 0.6666667 0.3333333   0.6666667  0.3333333 0.3333333 0.6666667       0

由于您添加了预期结果，所以我不确定该结果是以何种方式生成的。我给你两个选择：

选项1：使用源数据根据给定的ids进行乘法。

#option 1       
data.frame(id = ids) %>% inner_join(df, by='id') %>% 
  gather(key, value, -id) %>%
  group_by(key, value) %>%
  mutate(n = 1) %>%
  complete(nesting(key,value),id, fill=list(n = 0)) %>%
  summarise(n = sum(n)) %>%
  group_by(key) %>%
  mutate(p = n/sum(n))

其结果是：

    key value     n          p
  <chr> <chr> <dbl>      <dbl>
1 prop1     A     9 0.69230769
2 prop1     B     4 0.30769231
3 prop2 FALSE     9 0.69230769
4 prop2  TRUE     4 0.30769231
5 prop3     4     4 0.30769231
6 prop3     5     8 0.61538462
7 prop3     6     1 0.07692308    

或选项2：使用聚合数据并计算平均比例。

#option 2
df %>% gather(key,value,-id) %>% mutate(n = 1) %>%
  complete(nesting(key,value),id, fill=list(n = 0)) %>%
  group_by(id, key, value) %>%
  summarise(n = sum(n)) %>%
  group_by(id, key) %>%
  mutate(p = n/sum(n)) %>%
  inner_join(data.frame(id = ids), by='id') %>% 
  group_by(key, value) %>%
  summarise(p = mean(p)) 

其结果是：

Source: local data frame [7 x 3]
Groups: key [?]

    key value         p
  <chr> <chr>     <dbl>
1 prop1     A 0.7333333
2 prop1     B 0.2666667
3 prop2 FALSE 0.7333333
4 prop2  TRUE 0.2666667
5 prop3     4 0.2666667
6 prop3     5 0.5333333
7 prop3     6 0.2000000