insertar - listas en r
Compare dos data.frames para encontrar las filas en data.frame 1 que no están presentes en data.frame 2 (11)
Tengo los siguientes 2 data.frames:
a1 <- data.frame(a = 1:5, b=letters[1:5])
a2 <- data.frame(a = 1:3, b=letters[1:3])
Quiero encontrar la fila a1 que tiene a2 no.
¿Hay una función incorporada para este tipo de operación?
(ps: escribí una solución para eso, simplemente tengo curiosidad si alguien ya hizo un código más elaborado)
Aquí está mi solución:
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)
Adapte la función de merge para obtener esta funcionalidad. En marcos de datos más grandes, utiliza menos memoria que la solución de fusión completa. Y puedo jugar con los nombres de las columnas clave.
Otra solución es usar el prob la biblioteca.
# 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)
}
Ciertamente, no es eficiente para este propósito en particular, pero lo que a menudo hago en estas situaciones es insertar variables de indicador en cada data.frame y luego fusionar:
a1$included_a1 <- TRUE
a2$included_a2 <- TRUE
res <- merge(a1, a2, all=TRUE)
los valores faltantes en included_a1 notarán qué filas faltan en a1. de manera similar para a2.
Un problema con su solución es que los pedidos de columna deben coincidir. Otro problema es que es fácil imaginar situaciones en las que las filas están codificadas como iguales cuando en realidad son diferentes. La ventaja de usar merge es que obtienes de forma gratuita todas las comprobaciones de error necesarias para una buena solución.
En dplyr :
setdiff(a1,a2)
Básicamente, setdiff(bigFrame, smallFrame) le proporciona los registros adicionales en la primera tabla.
En el SQLverse esto se llama
Para obtener una buena descripción de todas las opciones de unión y establecer temas, este es uno de los mejores resúmenes que he visto reunido hasta la fecha: http://www.vertabelo.com/blog/technical-articles/sql-joins
Pero volvamos a esta pregunta: aquí están los resultados para el código setdiff() al usar los datos de 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
O incluso anti_join(a1,a2) obtendrá los mismos resultados.
Para más información: https://www.rstudio.com/wp-content/uploads/2015/02/data-wrangling-cheatsheet.pdf
Escribí un paquete ( https://github.com/alexsanjoseph/compareDF ) porque tenía el mismo problema.
> 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
Un ejemplo más complicado:
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
El paquete también tiene un comando html_output para una comprobación rápida
Esto no responde su pregunta directamente, pero le dará los elementos que están en común. Esto se puede hacer con la compare del paquete de Paul Murrell:
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
La función de compare le da mucha flexibilidad en términos de qué tipo de comparaciones se permiten (por ejemplo, cambiar el orden de los elementos de cada vector, cambiar el orden y los nombres de las variables, acortar las variables, cambiar el caso de las cadenas). A partir de esto, debería ser capaz de descubrir qué le faltaba a uno u otro. Por ejemplo (esto no es muy elegante):
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
Otra solución más basada en match_df en plyr. Aquí está el match_df de 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]
}
Podemos modificarlo para negar:
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]
}
Entonces:
diff <- negate_match_df(a1,a2)
Podría usar el paquete daff (que envuelve la biblioteca daff.js usando el paquete V8 ):
library(daff)
diff_data(data_ref = a2,
data = a1)
produce el siguiente objeto de diferencia:
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
El formato diff se describe en formato Coopy highlighter diff para tablas y debe ser bastante fácil de entender . Las líneas con +++ en la primera columna @@ son las nuevas en a1 y no están presentes en a2 .
El objeto de diferencia se puede usar para patch_data() , para almacenar la diferencia para propósitos de documentación usando write_diff() o para visualizar la diferencia usando render_diff() :
render_diff(
diff_data(data_ref = a2,
data = a1)
)
genera una salida HTML ordenada:
Quizás es demasiado simplista, pero usé esta solución y la encuentro muy útil cuando tengo una clave principal que puedo usar para comparar conjuntos de datos. Espero que pueda ayudar.
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,]
Sus datos de ejemplo no tienen duplicados, pero su solución los maneja automáticamente. Esto significa que potencialmente algunas de las respuestas no coincidirán con los resultados de su función en caso de duplicados.
Aquí está mi solución, cuya dirección se duplica de la misma manera que la tuya. ¡También escalas genial!
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
Necesita data.table 1.9.7 que actualmente se puede instalar desde el repositorio de origen
install.packages("data.table", type = "source",
repos = "https://Rdatatable.github.io/data.table")
SQLDF proporciona una buena solución
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'')
Y las filas que están en ambos cuadros de datos:
a1Ina2 <- sqldf(''SELECT * FROM a1 INTERSECT SELECT * FROM a2'')
La nueva versión de dplyr tiene una función, anti_join , para exactamente este tipo de comparaciones
require(dplyr)
anti_join(a1,a2)
Y semi_join para filtrar filas en a1 que también están en a2
semi_join(a1,a2)