您如何保留原始列以在 r 的兩個數據庫的 full_join() 中進行比較

Question

我正在嘗試比較兩個數據框，以確定其中一列的差異。 為了實現這一點，我使用了 tidyverse 的full_join() ，但我不知道如何保留數據框的來源，以便了解差異。

#Two databases that differ in Charge for the name and date or also have a entirely unique rows

df1 <- tibble(Name = c("JANE,DOE", "JANE,DOE", "JIM,DOE", "JANE,BUCK", "JIM,BUCK", "JIM,BUCK"),
Date = c("1/1/21", "1/10/21", "2/1/21", "1/2/21", "2/2/21", "2/8/21"),
Charge = c(-500, -500, -450, 0, -450, 0))

df2 <- tibble(Name = c("JANE,DOE", "JANE,DOE", "JIM,DOE", "JANE,BUCK", "JIM,BUCK", "JIM,BUCK", "JIM,BUCK"),
Date = c("1/2/21", "1/10/21", "2/1/21", "1/2/21", "2/2/21", "2/8/21", "2/10/21"),
Charge = c(-500, -500, -450, -500, -500, -500, -50))

我嘗試使用組合它們，然后識別不同的行

Audit <- full_join(df1,df2)
Audit <- Audit %>% distinct() %>% arrange(Name, Date)

但是我的 output 不允許我對比名稱和日期唯一的行的費用。

Name       Date    Charge
<chr>      <chr>   <dbl>
JANE,BUCK   1/2/21  0       #df2
JANE,BUCK   1/2/21  -500    #df1    
JANE,DOE    1/1/21  -500    #df1    
JANE,DOE    1/10/21 -500    #df1 & df2  
JANE,DOE    1/2/21  -500    #df2    
JIM,BUCK    2/10/21 -50     #df2
JIM,BUCK    2/2/21  -450    #df1    
JIM,BUCK    2/2/21  -500    #df2    
JIM,BUCK    2/8/21  0       #df1
JIM,BUCK    2/8/21  -500    #df2    
JIM,DOE     2/1/21  -450    #df1

我最終要實現的是像這樣生成 output 的審計

Name       Date    Charge   ChargeDiff
<chr>      <chr>   <dbl>     <dbl>
JANE,BUCK   1/2/21  0       -500 #difference in Charge when name and date are same, but Charge differs
    
JANE,DOE    1/1/21  -500      0  #unique df1 is 0 because we know it is valid

JANE,DOE    1/2/21  -500    -500 #unique in df2 is -500 because it is missing   
JIM,BUCK    2/10/21 -50     -50  #unique in df2 is -50 because it is missing
JIM,BUCK    2/2/21  -450     50  # df1-df2 on 2/2 is -450-(-500) 

JIM,BUCK    2/8/21  0       500  # df1-df2

JIM,DOE     2/1/21  -450    #df1 #unique in df1

我在創建ChangeDiff列所需的步驟上遇到了一些麻煩。 這是一個不同的連接選項，它允許我將來自 df2 的唯一行僅添加到 Audit 中，但將來自 df2 的唯一 Charge 值保留在與 Name 和 Date 對齊的單獨列中。

Answer 1

使用full_join()時您已經快到了 使用by()參數允許您控制連接，以便您可以將兩組Charge包含在單獨的列中。 使用dplyr::mutate()和/或case_when()生成ChargeDiff列。

library(tibble)
library(dplyr)
tib <- 
  df1 %>% 
  full_join(df2, by = c("Name" = "Name", "Date" = "Date")) %>% 
  mutate(ChargDiff = case_when(is.na(Charge.x) | is.na(Charge.y) ~ NA_real_,
                               TRUE ~ Charge.x - Charge.y))

tib
#> # A tibble: 8 x 5
#>   Name      Date    Charge.x Charge.y ChargDiff
#>   <chr>     <chr>      <dbl>    <dbl>     <dbl>
#> 1 JANE,DOE  1/1/21      -500       NA        NA
#> 2 JANE,DOE  1/10/21     -500     -500         0
#> 3 JIM,DOE   2/1/21      -450     -450         0
#> 4 JANE,BUCK 1/2/21         0     -500       500
#> 5 JIM,BUCK  2/2/21      -450     -500        50
#> 6 JIM,BUCK  2/8/21         0     -500       500
#> 7 JANE,DOE  1/2/21        NA     -500        NA
#> 8 JIM,BUCK  2/10/21       NA      -50        NA

^{由代表 package (v1.0.0) 於 2021 年 3 月 24 日創建}

Answer 2

這看起來不漂亮——編碼方面； 但它會做一個“漂亮”的桌子。 該表將顯示在 RStudio 的查看器窗格中，並且與查看器一樣寬。

require(htmlTable)
require(compareDF)


# adds color
emph <- function(xCd){
  
  # create empty matrix
  css.cell = matrix(nrow = dim(xCd)[1], 
                    ncol = dim(xCd)[2] + 1)  # another column will be added for origin
  
  # for + add #003b70; for - add #b21e28
  where <- which(xCd == "+",   # origin in the first table
                 arr.ind = T)  # get dim loc
  css.cell[where] <- "font-weight:bold;color:#003b70;padding-left:1em;padding-right:1em;"

  where2 <- which(xCd == "-",  # origin in the second table
                  arr.ind = T)
  css.cell[where2] <- "font-weight:bold;color:#b21e28;padding-left:1em;padding-right:1em;"
  
  where3 <- which(css.cell == NA, 
                  arr.ind = T)
  css.cell[where3] <- "padding-left:1em;padding-right:1em;"
       # add padding for every where else; this sets a minimum width

  return(css.cell)
} # end udf

創建表

# creates table
fmtStyle <- function(frame1, frame2){
  # create the comparison
  comp <- compare_df(frame1, frame2,
                     keep_unchanged_rows = T)      # create the comparison
  
  # don't include rowname & chng_type columns-- 3 through the rest of the columns
  # keeps both frames' rows even if they're the same data; don't keep in this table
  compMat <- as.matrix(comp$comparison_table_diff[c(rownames(unique(comp[[1]]))),    
                                                  3:ncol(comp$comparison_table_diff)]) 
  css <- emph(compMat)    # collect colors
  
  # collect the joined data
  # don't include rowname & chng_type columns-- 3 through the rest of the columns
  # keeps both frames' rows even if they're the same data; don't keep in this table
  mat <- as.matrix(comp$comparison_table_ts2char[c(rownames(unique(comp[[1]]))),
                                                 3:ncol(comp$comparison_table_ts2char)])
  rownames(mat) <- NULL   # remove the rownames (they aren't meaningful)
  
  # make the data character type; the date column being an exception
  mat[,3] <- txtRound(mat[,3],0)  # make all values character data
  
  # add a column identifying origin
  Origins <- ifelse(comp$comparison_table_diff[c(rownames(unique(comp[[1]]))),
                                               ]$chng_type == "+", "df1",
                    ifelse(comp$comparison_table_diff[c(rownames(unique(comp[[1]]))),
                                                      ]$chng_type == "-", "df2",
                           "df1 & df2"))    

  # add origins to the matrix
  mat <- cbind(mat, Origins)
  
  # make it pretty
  soPretty <- mat %>% 
    addHtmlTableStyle(spacer.celltype = "double_cell",
                      css.cell = css, 
                      css.header = "font-weight: normal",
                      pos.caption = "bottom") %>% 
    htmlTable(cgroup = list(c("Comparison Audit")),
              n.cgroup = list(c(ncol(mat))),   # span the name cgroup words over all the columns
              caption = paste0("<i>Note</i>: Blue font indicates an origin that only exists in the first table;",
                               " where a red font indicates that the information is unique to the second table."))
                     # paste is used in the caption just make the caption readable in the script file
  return(soPretty)
} # end table creation function

要使用這些功能，請以這種方式調用它

# using it
(showMe <- fmtStyle(df1,df2))

要查看表格后面的 HTML 或對其進行修改，您可以通過這種方式查看腳本

as.character(showMe)