聚合直方图数据

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保存用于每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一组新的实验，重复。我需要使用l1的参考数据计算整个id's集合中每个属性的直方图。

某些id's可能不存在;一些id's不存在于原始df和l1可以存在于ids - 例如4在ids不存在于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 

base R solution is preferred。

更新：澄清如何计算输出。

ids的计数 - 一个1,2，2,3和3和4.因为我们没有4的数据，所以有用的ids是1,2和3，它们之间的总计数为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）。由于我正在重塑（融化）您在列表中生成的数据。之后，我将数据传播到一个不错的数据框架中。 Offcourse你也可以使用数据的标准化版本。 （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：使用源数据根据给定的ID进行乘法运算。

#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