2016-04-02 5 views
1

Ich arbeite mit sehr unordentlichen Familiendaten, in denen es möglich ist, dass Kinder mit mehreren Familien gruppiert werden. Die Daten ist wie folgt strukturiert:Identifizieren der relativen Größe von überlappenden Gruppen basierend auf Informationen in 2 Vektoren

famid <- c("A","A","B","C","C","D","D") 
kidid <- c("1","2","1","3","4","4","5") 
df <- as.data.frame(cbind(famid, kidid)) 

ich identifizieren wollen, die Familien, die ich fallen kann, auf der Grundlage der Kriterien, die alle Kinder in dieser Familie zusammen gruppiert sind in eine andere, größere, Familie.

Zum Beispiel Familie A enthält Kid 1 und Kid 2. Familie B enthält Kid 1. Weil Familie B vollständig innerhalb Familie A enthalten ist, möchte ich 3 Familie B.

Alternativ fallen, Familie C enthält Kid und Kid 4. Familie D enthält Kid 4 und Kid 5. Keine Familie ist vollständig in der anderen enthalten, so dass ich auch nicht vorläufig fallen lassen möchte.

In meinen Daten kann es bis zu 6 Familien pro Kind und bis zu 8 Kinder pro Familie geben. Es gibt Tausende von Familien und Tausende von Kindern.

Ich habe versucht, dies zu adressieren, indem ich eine sehr breite data.frame mit einer Zeile pro Schüler mit Spalten für jede Familie, der das Kind zugeordnet ist, jedes Geschwister in jeder Familie, die das Kind zugeordnet ist, und eine zusätzliche Spalte erstellt (sibgrp) für jede zugeordnete Familie, die alle Geschwister miteinander verkettet. Aber als ich versuchte, nach einzelnen Geschwistern innerhalb der verketteten Zeichenfolge zu suchen, fand ich, dass ich nicht wusste, wie man das macht - grepl wird keinen Vektor als das Musterargument nehmen.

Ich begann dann, Schnittpunkt und ähnliche Funktionen zu untersuchen, aber diese vergleichen ganze Vektoren miteinander, nicht Beobachtungen innerhalb eines Vektors zu anderen Beobachtungen innerhalb dieses Vektors. (Bedeutung - Ich kann nicht nach den Schnittpunkten zwischen der Zeichenkette df[1,2] und der Zeichenkette df[1,3] suchen. Intersect identifiziert stattdessen die Schnittpunkte zwischen df[2] und df[3]).

Ich versuchte, mein Denken zu ändern, um diesen Ansatz zu berücksichtigen, so dass ich Vektoren von Geschwistern miteinander vergleichen konnte, vorausgesetzt, dass ich bereits weiß, dass mindestens ein Geschwister geteilt wird. Ich konnte nicht herausfinden, wie ich überhaupt damit anfangen sollte, wenn man bedenkt, wie viele verschiedene Familien es gibt und wie viele von einem einzigen Kind nicht miteinander verwandt sind.

Was fehlt mir hier? Ich würde jedes Feedback sehr schätzen. Vielen Dank!

Antwort

0

Diese Funktion kann auch zur Ausführung der Aufgabe verwendet werden. Es gibt einen Zeichenvektor zurück, der die Namen der Familien enthält, die entfernt werden können.

test_function <- function(dataset){ 

## split the kidid on the basis of famid 
kids_family <- split.default(dataset[['kidid']],f = dataset[['famid']]) 

family <- names(kids_family) 

## This function generates all the possible combinations if we select any two families from family 
combn_family <- combn(family,2) 

family_removed <- character(0) 
apply(combn_family,MARGIN = 2, function(x){ 

    if (length(setdiff(kids_family[[x[1]]],kids_family[[x[2]]])) == 0) 
    family_removed <<- c(family_removed,x[1]) 
    else if (length(setdiff(kids_family[[x[2]]],kids_family[[x[1]]])) == 0) 
    family_removed <<- c(family_removed,x[2]) 

}) 

return (family_removed) 
} 
> df <- data.frame(famid = c("A","A","B","C","C","D","D", "E", "E", "E", "F", "F"), 
+     kidid = c(1, 2, 1, 3, 4, 4, 5, 7, 8, 9, 7, 9)) 
> test_function(df) 
[1] "B" "F" 
+0

Können Sie bitte Ihre Lösung detailliert beschreiben? –

+0

@VincentBonhomme Das war es, was ich tun wollte. –

+0

Danke, @Kunalpuri. Ich bin am Wochenende frei, werde es aber morgen als erstes ausprobieren. Es sieht wie eine sehr elegante Lösung aus, obwohl ich zugeben muss, dass ich seine inneren Abläufe nicht völlig verstehe. – szw

0

Ich habe um setdiff ohne Chance versucht. Ich kam und poste diese mühsame Lösung in der Hoffnung, dass es einen besseren Weg gibt.

# dependencies for melting tables and handling data.frames 
require(reshape2) 
require(dplyr) 


# I have added two more cases to your data.frame 
# kidid is passed as numeric (with quoted would have been changed to vector by default) 
df <- data.frame(famid = c("A","A","B","C","C","D","D", "E", "E", "E", "F", "F"), 
       kidid = c(1, 2, 1, 3, 4, 4, 5, 7, 8, 9, 7, 9)) 

# let's have a look to it 
df 
famid kidid 
1  A  1 
2  A  2 
3  B  1 
4  C  3 
5  C  4 
6  D  4 
7  D  5 
8  E  7 
9  E  8 
10  E  9 
11  F  7 
12  F  9 

# we build a contingency table 
m <- table(df$famid, df$kidid) 

# a family A only contains a family B, if A has all the elements of B, 
# and at least one that B doesnt have 
m 

    1 2 3 4 5 7 8 9 
A 1 1 0 0 0 0 0 0 
B 1 0 0 0 0 0 0 0 
C 0 0 1 1 0 0 0 0 
D 0 0 0 1 1 0 0 0 
E 0 0 0 0 0 1 1 1 
F 0 0 0 0 0 1 0 1 

# an helper function to implement that and return a friendly data.frame 
family_contained <- function(m){ 
    res <- list() 
    for (i in 1:nrow(m)) 
    # for each line in m, we calculate the difference to all other lines 
    res[[i]] <- t(apply(m[-i, ], 1, function(row) m[i, ] - row)) 
    # here we test if all values are 0+ (ie if the selected family has all element of the other) 
    # and if at least one is >=1 (ie if the selected family has at least one element that the other doesnt have) 
    tab <- sapply(res, function(m) apply(m, 1, function(x) all(x>=0) & any(x>=1))) 
    # we format it as a table to have nice names 
    tab %>% as.table() %>% 
    # we melt it into a data.frame 
    melt() %>% 
    # only select TRUE and get rid of this column 
    filter(value) %>% select(-value) %>% 
    # to make things clear we name columns 
    `colnames<-`(c("this_family_is_contained", "this_family_contains")) 
} 

family_contained(m) 
# this_family_is_contained this_family_contains 
# 1   B    A 
# 2   F    E 

# finally you can filter them with 
filter(df, !(famid %in% family_contained(m)$this_family_is_contained)) 
+0

Danke, dass Sie sich so gründlich damit beschäftigt haben, @VincentBonhomme – szw

Verwandte Themen