df1_Drop [ID_posin1] < - df2_Pick [ID_posin2]交換するアイテムの数は

Question

以下は正常に動作し、今日は突然警告を思い付いたコードで置き換え長の倍数ではありません

コードはで使用されている

次の行

警告が表示され、出力が正しくない理由が見つかりません。

Cost_match<-match_cost(SingleValueDistribute = F,df1_ID = Net_Rev$`Man.ID`, 
         df2_ID = Production_cost$Man.ID, 
         df2_Pick = Production_cost$Man.Revenue, 
         df1_Drop = Net_Rev$`Man.Revenue`, 
         df1_Dist_by = Net_Rev$Revenue,dist = T,weighted = T) 

警告メッセージ：df1_Drop [ID_posin1] <で - df2_Pick [ID_posin2]：交換するアイテムの
数はあなたが持っている交換用長

match_cost<-function(SingleValueDistribute=F, df1_ID,df2_ID,df2_Pick,df1_Drop,df1_Dist_by,weighted=F,dist=F){ 
    # SingleValueDistribute allows to distribute a single value across many rows 
    # IDs not needed in this case 

    if(SingleValueDistribute==T) { 
    sum<-sum(df1_Dist_by) 
    perc<-df1_Dist_by/sum 
    cost<-df2_Pick 
    df1_Drop<-perc*cost 
    reps<-NULL 
    print(" Singular Value Distributed") 
    }else{             
    df<-data.frame(table(df1_ID)) 
    df<-df[which(df$df1_ID %in% df2_ID),] 
    reps<-as.character(unique(df$df1_ID[which(df$Freq>1)])) 

    if (length(reps)>0 & dist==F) { 
     print("Multiple IDs; Values not Distributed") 
    } else if(length(reps)>0 & dist==T & weighted==T){ 


     for(i in df2_ID){ #Loop to distribued by df1_Dist_by 
     rows<-which(df1_ID==i) 
     sum<-sum(df1_Dist_by[rows]) 
     cost<-df2_Pick[which(df2_ID==i)] 
     if(sum==0){ 
      df1_Drop[rows][1]<-cost 
     }else{ 
      perc<-df1_Dist_by[rows]/sum 
      df1_Drop[rows]<-perc*cost 
     } 
     } 
     print("Multiple IDs; Value Weighted and Distributed") 
    }else{ 
     # Direct matching  
     unique_ID<-unique(df2_ID) #Get unique IDs 

     #Find positions of unique IDs the two data sets 
     ID_posin1<- match(x = unique_ID, table = df1_ID, nomatch = 0) # Find position of unique Ids 
     ID_posin2<- match(x = unique_ID, table = df2_ID, nomatch = 0) # Find position of unique Ids 

     # Find corresponding cost positions 

     df1_Drop[ID_posin1]<-df2_Pick[ID_posin2]     
     if(length(reps)>0) print("Multiple IDs; Values singularly Distributed") else 
     print("Singular IDs; Values Distributed") 
    } 
    } 
    return(list(df1_Drop=df1_Drop,rep_ID=reps)) 
} 

Answer 1

の倍数ではありません。 2つのデータソースの間にデータの不一致があります。これは最初のデータセットには表示されませんでした。すべてのdf1のIDがdf2で、の逆の場合はと仮定しているようです。

unique_ID <- 100:101 
df1_Drop <- 1:3 
df2_Pick <- 4:6 
# Find positions of unique IDs the two data sets 
# Find position of unique Ids 
ID_posin1 <- match(x = unique_ID, table = 101:103, nomatch = 0) 
ID_posin1 
# [1] 0 1 

# Find position of unique Ids 
ID_posin2 <- match(x = unique_ID, table = 100:103, nomatch = 0) 
ID_posin2 
# [1] 1 2 

df1_Drop[ID_posin1] <- df2_Pick[ID_posin2] 
# Warning message: 
# In df1_Drop[ID_posin1] <- df2_Pick[ID_posin2] : 
# number of items to replace is not a multiple of replacement length 

df1_Drop 
# [1] 4 2 3 

は、関数の開始時に作成し、あなたは驚きに遭遇しにくくなり、すべての前提条件をテストする習慣をつけましょう！たとえば、次のように

# check inputs 
if (!all(df1_ID %in% df2_ID)) { stop("not all df1_ID are in df2_ID") } 
if (!all(df2_ID %in% df1_ID)) { stop("not all df2_ID are in df1_ID") } 

は編集：私は、次のブロックは、あなたが望む行動を持っていないと思う：

# Direct matching  
    unique_ID<-unique(df2_ID) #Get unique IDs 

    #Find positions of unique IDs the two data sets 
    # Find position of unique Ids 
    ID_posin1<- match(x = unique_ID, table = df1_ID, nomatch = 0) 
    # Find position of unique Ids 
    ID_posin2<- match(x = unique_ID, table = df2_ID, nomatch = 0) 

    # Find corresponding cost positions 

    df1_Drop[ID_posin1]<-df2_Pick[ID_posin2] 

あなたがIDに対応するレコードを更新しようとしているが、行うことは非常に危険です各IDの各レコードが同じ場所にあることが確実な場合を除いて私はデータセットに対してこの仮定をしませんが、代わりにdf1のIDでデータを割り当てます。 IDごとに複数のDropが必要な場合は、df1とdf2のレコード数のミスマッチを処理するために、これをさらに洗練されたものにする必要があります。

df1_ID <- 100:101 
df2_ID <- 101:102 
df1_Drop <- 1:2 
df2_Pick <- 4:5 
unique_ID1 <- unique(df1_ID) 

for (id in seq_along(unique_ID1)) { 
    # how many unique Pick records are there for each ID in df2? 
    nrec <- length(unique(df2_Pick[df2_ID %in% unique_ID1[id]])) 
    if (nrec < 1L) { 
     warning(nrec, " Pick values for ID:", unique_ID1[id], " in df2, ", 
      "Drop was not replaced") 
     # if no records in df2 for and ID from df1, retain Drop 
    } else { 
     pick <- df2_Pick[df2_ID %in% unique_ID1[id]] 
     if (nrec > 1L) { 
      warning(nrec, " Pick values for ID:", unique_ID1[id], 
       " in df2, ", "Drop was replaced with first element") 
      pick <- pick[1] 
     } 
     # set the Drop value of each ID to be the corresponding Pick value 
     df1_Drop[df1_ID == unique_ID1[id]] <- pick 
    } 
} 
# Warning message: 
# 0 Pick values for ID:100 in df2, Drop was not replaced 
df1_Drop 
# [1] 1 4 

上記のように手動でレコードを収集するのではなく、これらの列をマージする方がいいかもしれません。