Jak utworzyć losowe dopasowanie między wierszami dwóch danych.tabela (lub data.frames)

Question

Dla tego przykładu użyję pakietu data.table.

Załóżmy, że masz tabelę trenerów

coaches <- data.table(CoachID=c(1,2,3), CoachName=c("Bob","Sue","John"), NumPlayers=c(2,3,0)) 
coaches 
    CoachID CoachName NumPlayers 
1:  1  Bob   2 
2:  2  Sue   3 
3:  3  John   0 

oraz tabelę graczy

players <- data.table(PlayerID=c(1,2,3,4,5,6), PlayerName=c("Abe","Bart","Chad","Dalton","Egor","Frank")) 
players 
    PlayerID PlayerName 
1:  1  Abe 
2:  2  Bart 
3:  3  Chad 
4:  4  Dalton 
5:  5  Egor 
6:  6  Frank 

chcesz dopasować każdy trener z kompletem graczy tak, że

• liczba graczy związanych z każdym trenerem jest określona przez pole NumPlayers
• Nie dwa autokary są przypisane do tego samego gracza
• zawodników i trenerów są dopasowywane losowo

Jak Ci to?

exampleResult <- data.table(CoachID=c(1,1,2,2,2,3), PlayerID=c(3,1,2,5,6,NA)) 
exampleResult 

    CoachID PlayerID 
1:  1  3 
2:  1  1 
3:  2  2 
4:  2  5 
5:  2  6 
6:  3  NA 

Answer 1

Można spróbować bez wymiany z identyfikatorami graczy, chwytając łączna liczba graczy trzeba:

set.seed(144) 
(selections <- sample(players$PlayerID, sum(coaches$NumPlayers))) 
# [1] 1 4 3 2 6 

Każdy gracz będzie miał równe prawdopodobieństwo wchodzących w selections, a zamawianie że wektor jest losowy. W związku z tym można po prostu przypisać tych graczy w każdej szczelinie coachingu:

data.frame(CoachID=rep(coaches$CoachID, coaches$NumPlayers), 
      PlayerID=selections) 
# CoachID PlayerID 
# 1  1  1 
# 2  1  4 
# 3  2  3 
# 4  2  2 
# 5  2  6 

Jeśli chciał mieć NA wartość dla dowolnych trenerów bez żadnych wyborów gracza, można zrobić coś takiego:

rbind(data.frame(CoachID=rep(coaches$CoachID, coaches$NumPlayers), 
       PlayerID=selections), 
     data.frame(CoachID=coaches$CoachID[coaches$NumPlayers==0], 
       PlayerID=rep(NA, sum(coaches$NumPlayers==0)))) 
# CoachID PlayerID 
# 1  1  1 
# 2  1  4 
# 3  2  3 
# 4  2  2 
# 5  2  6 
# 6  3  NA 

Answer 2

Get popytu i podaż na każdej stronie, że tak powiem:

demand <- with(coaches,rep(CoachID,NumPlayers)) 
supply <- players$PlayerID 

Potem robię ...

randmatch <- function(demand,supply){ 
    n_demand <- length(demand) 
    n_supply <- length(supply) 
    n_matches <- min(n_demand,n_supply) 

    if (n_demand >= n_supply) 
    data.frame(d=sample(demand,n_matches),s=supply) 
    else 
    data.frame(d=demand,s=sample(supply,n_matches)) 
} 

Przykłady:

set.seed(1) 
randmatch(demand,supply) # some players unmatched, OP's example 
randmatch(rep(1:3,1:3),1:4) # some coaches unmatched 

Nie jestem pewien, czy jest to przypadek PO chciała pokryć, choć.

---

Dla PO w pożądanym wyjściem ...

m <- randmatch(demand,supply) 
merge(m,coaches,by.x="d",by.y="CoachID",all=TRUE) 
# d s CoachName NumPlayers 
# 1 1 2  Bob   2 
# 2 1 6  Bob   2 
# 3 2 3  Sue   3 
# 4 2 4  Sue   3 
# 5 2 1  Sue   3 
# 6 3 NA  John   0 

Podobnie ...

merge(m,players,by.x="s",by.y="PlayerID",all=TRUE) 
# s d PlayerName 
# 1 1 2  Abe 
# 2 2 1  Bart 
# 3 3 2  Chad 
# 4 4 2  Dalton 
# 5 5 NA  Egor 
# 6 6 1  Frank 

Answer 3

Oto odpowiedź za pomocą prostych dplyr. Najpierw wybieranie potrzeb trenera, a następnie pobieranie próbek potrzeb gracza i wreszcie cbinding to wszystko.

library(dplyr) 

set.seed(1234) 

coach_needs <- coaches %>% 
    group_by(CoachID) %>% 
    do(sample_n(., size=.$NumPlayers, replace=TRUE)) %>% 
    select(-CoachID) %>% ungroup() 

player_needs <- players %>% 
    sample_n(size = nrow(coach_needs)) 

result <- cbind(coach_needs, player_needs) 

result 

co daje mi:

CoachID CoachName NumPlayers PlayerID PlayerName 
1:  1  Bob   2  4  Dalton 
2:  1  Bob   2  1  Abe 
3:  2  Sue   3  5  Egor 
4:  2  Sue   3  2  Bart 
5:  2  Sue   3  3  Chad 

UPDATE: Jeśli NA s są pożądane dla trenerów z NumPlayer == 0 to jest łatwe-liner:

result <- cbind(coach_needs, player_needs) %>% 
    rbind(coaches %>% filter(NumPlayers == 0), fill=TRUE) 

result 

który daje mi to:

CoachID CoachName NumPlayers PlayerID PlayerName 
1:  1  Bob   2  4  Dalton 
2:  1  Bob   2  1  Abe 
3:  2  Sue   3  5  Egor 
4:  2  Sue   3  2  Bart 
5:  2  Sue   3  3  Chad 
6:  3  John   0  NA   NA