Aggregat Histogramm Daten

Question

Ich habe das Histogramm für eine Reihe von Eigenschaften von verschiedenen einzigartigen Modellen von etwas "Ding". Wenn ich ein Experiment mache, finde ich mehrere dieser einzigartigen Modelle. Ich muss das Histogramm jeder Eigenschaft unter Berücksichtigung des gesamten Probensatzes des Experiments finden.

Beispiel:

Mit einem Datenrahmen df wie unten, mit einem Bündel von id's und für jeden id gibt es eine Reihe von Eigenschaften prop1 genannt, prop2 und so weiter.

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 

Für eqch einzigartige id ein Histogramm für jede Eigenschaft und das Ergebnis berechnet wird, wird in einer Liste l1 gespeichert, die für jedes Objekt auf einer pro id Basis des Histogramms hält.

# 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 

Jetzt unten Ich habe einen neuen Satz von ids von einem neuen Versuch, mit Wiederholungen. Ich muss das Histogramm für jede Eigenschaft über den Satz von id's mit den Referenzdaten von l1 berechnen.

Einige id's sind möglicherweise nicht vorhanden; Beispiel 4 in ids nicht vorhanden ist in l1 - - einige id's nicht in der ursprünglichen df und l1 kann in ids vorliegen jedoch können diese aus dem Histogramm-Berechnung ausgeschlossen werden, jedoch mit ausgeschlossenen id als Datenrahmen erfasst und für jeden id zählen ausgeschlossen .

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

Update: Erwartete Ausgabe - ich bin es als Listen- andere Datenstruktur zeigt, die besser geeignet verwendet werden könnten.

> 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 

Basislösung R bevorzugt.

Aktualisieren: Erläuterung, wie die Ausgabe berechnet wird.

Counts in ids - ein 1 zwei 2, 3 und drei ein 4. Da wir für 4 irgendwelche Daten nicht über die nützliche ids sind 1, 2 und 3 mit einer Gesamtzahl von 6 ids zwischen ihnen.

Für prop1 kann das aggregierte Histogramm für ids wie folgt berechnet werden

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

Ich habe eine Lösung für Sie, dass andere Pakete mit sich bringt (dplyr und tidyr). Da ich die Daten, die Sie in einer Liste generiert haben, umforme (schmelze). Danach verbreite ich die Daten in einem schönen data.frame. Natürlich können Sie auch die normalisierte Version der Daten verwenden. (df) innerhalb 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 
})) 
) 
) 

Ergebnis:

> 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 

Sie können dies auch ohne Ihre prop.table Funktion erreichen und nur dplyr, die eine viel sauberere Lösung.

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),] 

Ergebnis:

# 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 

---

Da Sie das erwartete Ergebnis hinzugefügt, ich bin nicht sicher, in welcher Weise dieses Resultat generiert wurde. Ich gebe Ihnen zwei Möglichkeiten:

Option 1: mit den Quelldaten zu multiplizieren nach den angegebenen 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)) 

die Ergebnisse:

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  

oder Option 2: die aggregierten Daten verwenden und den mittleren Anteil berechnen.

#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)) 

die Ergebnisse:

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