Bandingkan dua data.frame untuk menemukan baris dalam data.frame 1 yang tidak ada dalam data.frame 2

Saya memiliki 2 data.frame berikut:

a1 <- data.frame(a = 1:5, b=letters[1:5])
a2 <- data.frame(a = 1:3, b=letters[1:3])

Saya ingin mencari baris a1 yang a2 tidak.

Apakah ada fungsi bawaan untuk jenis operasi ini?

(ps: Saya memang menulis solusi untuk itu, saya hanya ingin tahu apakah seseorang telah membuat kode yang lebih baik)

Ini solusinya:

a1 <- data.frame(a = 1:5, b=letters[1:5])
a2 <- data.frame(a = 1:3, b=letters[1:3])

rows.in.a1.that.are.not.in.a2  <- function(a1,a2)
{
    a1.vec <- apply(a1, 1, paste, collapse = "")
    a2.vec <- apply(a2, 1, paste, collapse = "")
    a1.without.a2.rows <- a1[!a1.vec %in% a2.vec,]
    return(a1.without.a2.rows)
}
rows.in.a1.that.are.not.in.a2(a1,a2)

Ini tidak menjawab pertanyaan Anda secara langsung, tetapi akan memberi Anda elemen yang sama. Ini dapat dilakukan dengan paket Paul Murrell compare:

library(compare)
a1 <- data.frame(a = 1:5, b = letters[1:5])
a2 <- data.frame(a = 1:3, b = letters[1:3])
comparison <- compare(a1,a2,allowAll=TRUE)
comparison$tM
#  a b
#1 1 a
#2 2 b
#3 3 c

Fungsi ini comparememberi Anda banyak fleksibilitas dalam hal perbandingan seperti apa yang diizinkan (misalnya mengubah urutan elemen dari masing-masing vektor, mengubah urutan dan nama variabel, memendekkan variabel, mengubah kasus string). Dari ini, Anda harus bisa mengetahui apa yang hilang dari satu atau yang lain. Misalnya (ini tidak terlalu elegan):

difference <-
   data.frame(lapply(1:ncol(a1),function(i)setdiff(a1[,i],comparison$tM[,i])))
colnames(difference) <- colnames(a1)
difference
#  a b
#1 4 d
#2 5 e

SQLDF memberikan solusi yang bagus

a1 <- data.frame(a = 1:5, b=letters[1:5])
a2 <- data.frame(a = 1:3, b=letters[1:3])

require(sqldf)

a1NotIna2 <- sqldf('SELECT * FROM a1 EXCEPT SELECT * FROM a2')

Dan baris yang ada di kedua frame data:

a1Ina2 <- sqldf('SELECT * FROM a1 INTERSECT SELECT * FROM a2')

Versi baru dplyrmemiliki fungsi anti_join,, untuk perbandingan semacam ini

require(dplyr) 
anti_join(a1,a2)

Dan semi_joinuntuk menyaring baris a1yang juga ada dia2

semi_join(a1,a2)

Dalam dplyr :

setdiff(a1,a2)

Pada dasarnya, setdiff(bigFrame, smallFrame)memberi Anda catatan tambahan di tabel pertama.

Dalam SQLverse ini disebut

Untuk deskripsi yang baik dari semua opsi bergabung dan menetapkan mata pelajaran, ini adalah salah satu ringkasan terbaik yang saya lihat disatukan: http://www.vertabelo.com/blog/technical-articles/sql-joins

Tetapi kembali ke pertanyaan ini - ini adalah hasil untuk setdiff()kode ketika menggunakan data OP:

> a1
  a b
1 1 a
2 2 b
3 3 c
4 4 d
5 5 e

> a2
  a b
1 1 a
2 2 b
3 3 c

> setdiff(a1,a2)
  a b
1 4 d
2 5 e

Atau bahkan Anda anti_join(a1,a2)akan mendapatkan hasil yang sama.
Untuk info lebih lanjut: https://www.rstudio.com/wp-content/uploads/2015/02/data-wrangling-cheatsheet.pdf

Ini tentu saja tidak efisien untuk tujuan khusus ini, tetapi yang sering saya lakukan dalam situasi ini adalah memasukkan variabel indikator di setiap data.frame dan kemudian menggabungkan:

a1$included_a1 <- TRUE
a2$included_a2 <- TRUE
res <- merge(a1, a2, all=TRUE)

nilai-nilai yang hilang di Included_a1 akan mencatat baris mana yang hilang dalam a1. sama untuk a2.

Satu masalah dengan solusi Anda adalah bahwa pesanan kolom harus cocok. Masalah lain adalah mudah untuk membayangkan situasi di mana baris dikodekan sebagai sama padahal sebenarnya berbeda. Keuntungan menggunakan penggabungan adalah Anda mendapatkan secara gratis semua pengecekan kesalahan yang diperlukan untuk solusi yang baik.

Saya menulis sebuah paket ( https://github.com/alexsanjoseph/compareDF ) karena saya memiliki masalah yang sama.

  > df1 <- data.frame(a = 1:5, b=letters[1:5], row = 1:5)
  > df2 <- data.frame(a = 1:3, b=letters[1:3], row = 1:3)
  > df_compare = compare_df(df1, df2, "row")

  > df_compare$comparison_df
    row chng_type a b
  1   4         + 4 d
  2   5         + 5 e

Contoh yang lebih rumit:

library(compareDF)
df1 = data.frame(id1 = c("Mazda RX4", "Mazda RX4 Wag", "Datsun 710",
                         "Hornet 4 Drive", "Duster 360", "Merc 240D"),
                 id2 = c("Maz", "Maz", "Dat", "Hor", "Dus", "Mer"),
                 hp = c(110, 110, 181, 110, 245, 62),
                 cyl = c(6, 6, 4, 6, 8, 4),
                 qsec = c(16.46, 17.02, 33.00, 19.44, 15.84, 20.00))

df2 = data.frame(id1 = c("Mazda RX4", "Mazda RX4 Wag", "Datsun 710",
                         "Hornet 4 Drive", " Hornet Sportabout", "Valiant"),
                 id2 = c("Maz", "Maz", "Dat", "Hor", "Dus", "Val"),
                 hp = c(110, 110, 93, 110, 175, 105),
                 cyl = c(6, 6, 4, 6, 8, 6),
                 qsec = c(16.46, 17.02, 18.61, 19.44, 17.02, 20.22))

> df_compare$comparison_df
    grp chng_type                id1 id2  hp cyl  qsec
  1   1         -  Hornet Sportabout Dus 175   8 17.02
  2   2         +         Datsun 710 Dat 181   4 33.00
  3   2         -         Datsun 710 Dat  93   4 18.61
  4   3         +         Duster 360 Dus 245   8 15.84
  5   7         +          Merc 240D Mer  62   4 20.00
  6   8         -            Valiant Val 105   6 20.22

Paket ini juga memiliki perintah html_output untuk pemeriksaan cepat

df_compare $ html_output

Anda bisa menggunakan daffpaket (yang membungkus daff.jsperpustakaan menggunakan V8paket ):

library(daff)

diff_data(data_ref = a2,
          data = a1)

menghasilkan objek perbedaan berikut:

Daff Comparison: ‘a2’ vs. ‘a1’ 
  First 6 and last 6 patch lines:
   @@   a   b
1 ... ... ...
2       3   c
3 +++   4   d
4 +++   5   e
5 ... ... ...
6 ... ... ...
7       3   c
8 +++   4   d
9 +++   5   e

Format diff dijelaskan dalam format diff Highlighter Coopy untuk tabel dan harus cukup jelas. Baris-baris dengan +++pada kolom pertama @@adalah yang baru masuk a1dan tidak ada dalam a2.

Objek perbedaan dapat digunakan untuk patch_data(), menyimpan perbedaan untuk tujuan dokumentasi menggunakan write_diff()atau untuk memvisualisasikan perbedaan menggunakanrender_diff() :

render_diff(
    diff_data(data_ref = a2,
              data = a1)
)

menghasilkan output HTML yang rapi:

Menggunakan diffobjpaket:

library(diffobj)

diffPrint(a1, a2)
diffObj(a1, a2)

Saya mengadaptasi mergefungsi untuk mendapatkan fungsi ini. Pada kerangka data yang lebih besar itu menggunakan lebih sedikit memori daripada solusi penggabungan penuh. Dan saya bisa bermain dengan nama-nama kolom kunci.

Solusi lain adalah dengan menggunakan perpustakaan prob.

#  Derived from src/library/base/R/merge.R
#  Part of the R package, http://www.R-project.org
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  http://www.r-project.org/Licenses/

XinY <-
    function(x, y, by = intersect(names(x), names(y)), by.x = by, by.y = by,
             notin = FALSE, incomparables = NULL,
             ...)
{
    fix.by <- function(by, df)
    {
        ## fix up 'by' to be a valid set of cols by number: 0 is row.names
        if(is.null(by)) by <- numeric(0L)
        by <- as.vector(by)
        nc <- ncol(df)
        if(is.character(by))
            by <- match(by, c("row.names", names(df))) - 1L
        else if(is.numeric(by)) {
            if(any(by < 0L) || any(by > nc))
                stop("'by' must match numbers of columns")
        } else if(is.logical(by)) {
            if(length(by) != nc) stop("'by' must match number of columns")
            by <- seq_along(by)[by]
        } else stop("'by' must specify column(s) as numbers, names or logical")
        if(any(is.na(by))) stop("'by' must specify valid column(s)")
        unique(by)
    }

    nx <- nrow(x <- as.data.frame(x)); ny <- nrow(y <- as.data.frame(y))
    by.x <- fix.by(by.x, x)
    by.y <- fix.by(by.y, y)
    if((l.b <- length(by.x)) != length(by.y))
        stop("'by.x' and 'by.y' specify different numbers of columns")
    if(l.b == 0L) {
        ## was: stop("no columns to match on")
        ## returns x
        x
    }
    else {
        if(any(by.x == 0L)) {
            x <- cbind(Row.names = I(row.names(x)), x)
            by.x <- by.x + 1L
        }
        if(any(by.y == 0L)) {
            y <- cbind(Row.names = I(row.names(y)), y)
            by.y <- by.y + 1L
        }
        ## create keys from 'by' columns:
        if(l.b == 1L) {                  # (be faster)
            bx <- x[, by.x]; if(is.factor(bx)) bx <- as.character(bx)
            by <- y[, by.y]; if(is.factor(by)) by <- as.character(by)
        } else {
            ## Do these together for consistency in as.character.
            ## Use same set of names.
            bx <- x[, by.x, drop=FALSE]; by <- y[, by.y, drop=FALSE]
            names(bx) <- names(by) <- paste("V", seq_len(ncol(bx)), sep="")
            bz <- do.call("paste", c(rbind(bx, by), sep = "\r"))
            bx <- bz[seq_len(nx)]
            by <- bz[nx + seq_len(ny)]
        }
        comm <- match(bx, by, 0L)
        if (notin) {
            res <- x[comm == 0,]
        } else {
            res <- x[comm > 0,]
        }
    }
    ## avoid a copy
    ## row.names(res) <- NULL
    attr(res, "row.names") <- .set_row_names(nrow(res))
    res
}


XnotinY <-
    function(x, y, by = intersect(names(x), names(y)), by.x = by, by.y = by,
             notin = TRUE, incomparables = NULL,
             ...)
{
    XinY(x,y,by,by.x,by.y,notin,incomparables)
}

Contoh data Anda tidak memiliki duplikat, tetapi solusi Anda menanganinya secara otomatis. Ini berarti bahwa beberapa jawaban yang berpotensi tidak akan cocok dengan hasil fungsi Anda jika ada duplikat.
Ini solusi saya yang alamatnya sama dengan milik Anda. Ini juga berskala besar!

a1 <- data.frame(a = 1:5, b=letters[1:5])
a2 <- data.frame(a = 1:3, b=letters[1:3])
rows.in.a1.that.are.not.in.a2  <- function(a1,a2)
{
    a1.vec <- apply(a1, 1, paste, collapse = "")
    a2.vec <- apply(a2, 1, paste, collapse = "")
    a1.without.a2.rows <- a1[!a1.vec %in% a2.vec,]
    return(a1.without.a2.rows)
}

library(data.table)
setDT(a1)
setDT(a2)

# no duplicates - as in example code
r <- fsetdiff(a1, a2)
all.equal(r, rows.in.a1.that.are.not.in.a2(a1,a2))
#[1] TRUE

# handling duplicates - make some duplicates
a1 <- rbind(a1, a1, a1)
a2 <- rbind(a2, a2, a2)
r <- fsetdiff(a1, a2, all = TRUE)
all.equal(r, rows.in.a1.that.are.not.in.a2(a1,a2))
#[1] TRUE

Perlu data.tabel 1.9.8+

Mungkin terlalu sederhana, tetapi saya menggunakan solusi ini dan saya merasa sangat berguna ketika saya memiliki kunci utama yang dapat saya gunakan untuk membandingkan set data. Semoga bisa membantu.

a1 <- data.frame(a = 1:5, b = letters[1:5])
a2 <- data.frame(a = 1:3, b = letters[1:3])
different.names <- (!a1$a %in% a2$a)
not.in.a2 <- a1[different.names,]

Namun solusi lain berdasarkan match_df di plyr. Inilah match_df plyr:

match_df <- function (x, y, on = NULL) 
{
    if (is.null(on)) {
        on <- intersect(names(x), names(y))
        message("Matching on: ", paste(on, collapse = ", "))
    }
    keys <- join.keys(x, y, on)
    x[keys$x %in% keys$y, , drop = FALSE]
}

Kita dapat memodifikasinya untuk meniadakan:

library(plyr)
negate_match_df <- function (x, y, on = NULL) 
{
    if (is.null(on)) {
        on <- intersect(names(x), names(y))
        message("Matching on: ", paste(on, collapse = ", "))
    }
    keys <- join.keys(x, y, on)
    x[!(keys$x %in% keys$y), , drop = FALSE]
}

Kemudian:

diff <- negate_match_df(a1,a2)

Menggunakan subset:

missing<-subset(a1, !(a %in% a2$a))

Kode berikut menggunakan keduanya data.tabledan fastmatchuntuk meningkatkan kecepatan.

library("data.table")
library("fastmatch")

a1 <- setDT(data.frame(a = 1:5, b=letters[1:5]))
a2 <- setDT(data.frame(a = 1:3, b=letters[1:3]))

compare_rows <- a1$a %fin% a2$a
# the %fin% function comes from the `fastmatch` package

added_rows <- a1[which(compare_rows == FALSE)]

added_rows

#    a b
# 1: 4 d
# 2: 5 e