データフレーム内の複数の行にランダムに値を分配する

Question

私は2つのデータフレームを持っています。
DF1には、領域に割り当てられた一意のIDと、各IDに含まれる人数の数が含まれています。 （COUNT列）。
DF2には、地域を割り当てる必要がある人数の数が含まれます（CHANGE列）。

はエリアA.
に割り当てられた行はありがとうランダムに渡っ DF1に COUNT列に DF2に CHANGE列から余分な24人を追加して、例えばエリアAの場合には、の効率的な方法があります。

DF1 <- data.frame(matrix(0, nrow=20, ncol=3)) 
DF1[,1] <- 1:20 
DF1[,2] <- rep(c("A","B","C","D"), each=5) 
DF1[,3] <- sample(10:30,20,rep=TRUE) 
colnames(DF1) <- c("ID","AREA","COUNT") 

DF2 <- data.frame(matrix(0, nrow=4, ncol=2)) 
DF2[,1] <- c("A","B","C","D") 
DF2[,2] <- c(24,-17,-1,5) 
colnames(DF2) <- c("AREA","CHANGE") 

編集： これは私の現在の解決方法です。しかし、私の実際のデータセットには何千もの行が含まれており、完了するまでに数時間かかります。なぜ私は同じ目標を達成するより効率的な方法の後に来たのですか？

for (i in 1:length(unique(DF2[,1]))){ 
DF_Area <- unique(DF1[,2]) 
DF1_Subset <- with(DF1, DF1[AREA == DF_Area[i],]) 
DF2_Row <- DF2[DF2$AREA %in% DF_Area[i],] 

if(DF2_Row$CHANGE!=0){ 
DF1_Update <- as.data.frame(DF1_Subset$COUNT) 

if(DF2_Row$CHANGE>=0){ALLOCATION_VALUE <- 1}else{ALLOCATION_VALUE <- -1} 

for (GG in 1:abs(DF2_Row$CHANGE)){ 
DF1_Update_Row <- sample(which(DF1_Update > 0),1) 
DF1_Update[DF1_Update_Row, ] <- DF1_Update[DF1_Update_Row, ] + ALLOCATION_VALUE} 

DF1_Subset$COUNT <- DF1_Update[,1] 
DF1$COUNT[match(DF1$ID, DF1_Subset$ID, nomatch = 0) != 0] <- DF1_Subset$COUNT[match(DF1$ID, DF1_Subset$ID, nomatch = 0)]}} 

Answer 1

（これはどこの領域の任意の数のために、あらゆるID番号で作業を行いますが、あまりにも多くの人々がID

library(data.table) 

DF1 <- as.data.table(DF1,key="ID") 
DF1$AREA <- as.factor(DF1$AREA) #to change area as level 
dt_all <-NULL 

for (i in levels(DF1$AREA)) { 

    if (DF2[DF2$AREA == i,]$CHANGE != 0) { 
    bool_pos <- (DF2[DF2$AREA == i,]$CHANGE > 0) #to know to add or remove from count 

    ID <- sample(1:(length(DF1[AREA == i,]$ID)),abs(DF2[DF2$AREA == i,]$CHANGE), rep=TRUE) 
    ID <- DF1[AREA == i,]$ID[ID] # select random id for each value in change 
    df_temp <- as.data.table(table(ID),key="ID") 
    df_temp$ID <- as.integer(df_temp$ID) 
    if (!bool_pos) { 
     df_temp$N <- (df_temp$N)*-1 
    } 

    dt_all <- rbind(dt_all,df_temp) 
    } 
} 

DF1 <- merge(DF1, dt_all,all.x=TRUE, by="ID") 
DF1[is.na(N), N:=0] 
DF1[, COUNT:=COUNT+N] 
DF1[,N:=NULL] 
dt_all <-NULL 

Answer 2

これも動作するはずで削除された場合には、負の数を与えることができます残りの各数字が生成されるべき等間隔に合計CHANGEを分割することにより、毎回乱数が生成される）。また、ループ内でサブセット化する代わりにsplitを使用すると、処理が高速になります。

set.seed(100) 
do.call(rbind, lapply(split(DF1, DF1$AREA), 
     function(x) { 
     tot <- DF2[DF2$AREA == unique(x[,'AREA']),]$CHANGE # total change needed 
     n <- nrow(x) 
     nums <- rep(0, n) 
     part.tot <- 0 
     for (i in 1:(n-1)) { 
      lb <- min(0, tot-part.tot) 
      ub <- max(0, tot-part.tot) 
      nums[i] <- round(runif(1, lb, ub)/(n-i+1)) # divide the remaining CHANGE into (n-i+1) equal parts 
      part.tot <- part.tot + nums[i] 
     } 
     nums[n] <- tot - part.tot # assign the remaining to the last element 
     x['COUNT'] <- x['COUNT'] + nums 
     x 
     })) 

     ID AREA COUNT 
#A.1 1 A 14 
#A.2 2 A 30 
#A.3 3 A 32 
#A.4 4 A 27 
#A.5 5 A 34 
#B.6 6 B 27 
#B.7 7 B 23 
#B.8 8 B 18 
#B.9 9 B 19 
#B.10 10 B  5 
#C.11 11 C 15 
#C.12 12 C 19 
#C.13 13 C 11 
#C.14 14 C 19 
#C.15 15 C 10 
#D.16 16 D 30 
#D.17 17 D 26 
#D.18 18 D 19 
#D.19 19 D 15 
#D.20 20 D 20