Looking to assign subgroup values to of a group to a common value in R

user_14198870 0
Viewed 36

I have a series of phone numbers that have individual names associated with them. The phone numbers are not necessarily unique, and sometimes the name associated with them is missing. I would like to fill in the names with the following rules:

  • If a grouped phone number has blank entries and only a single name available, I would like to replace the blank names with the one available.
  • If the grouped number has entries with multiple non-blank names, then I cannot determine who belongs to that phone number and so I make no changes.

Here is the original table:

library("dplyr")
phone = c("1234","1234","1234","4567","4567","4567","4567","4567");phone
sgroup = c("","Jones","","Smith","","Smith","Williams","Jones");sgroup

DATA = data.frame(phone,sgroup);DATA

And here is how I want it to look:

phone1 = c("1234","1234","1234","4567","4567","4567","4567","4567");phone1
sgroup1 = c("Jones","Jones","Jones","Smith","","Smith","Williams","Jones");sgroup1

DATA1 = data.frame(phone1,sgroup1)

Note the "1234" since it originally had only 'Jones" and Blanks(NAs) assigned, so I assigned all records in that group to 'Jones. The second number (4567) had multiple names assigned, so I was unable to determine a common name so no assignment was made.

I can determine which phones have blank or non-blank name assignments, but I have been unable to determine how to assign them back to the blank records in that group.

Countdf1 <- DATA %>% count(phone,sgroup)
dplyr r
2 Answers

I think this does what you need.

We go through all unique phone numbers (a kind of "group by") and then check if there's more than 2 unique names associated or if there are no missing names at all. If there are only two unique names and one of them is missing, that's when we apply your rule number 1. Else, we don't do anything.

phone = c("1234","1234","1234","4567","4567","4567","4567","4567")
sgroup = c("","Jones","","Smith","","Smith","Williams","Jones")

DATA = data.frame(phone,sgroup);


for (phone in unique(DATA$phone)) {
    names <- unique(DATA$sgroup[DATA$phone == phone])
    if (length(names) > 2 || all(!names %in% c(NA, "", NULL))) {
        next
    } else {
        df <- DATA[DATA$phone == phone, ]
        df$sgroup <- names[!names %in% c(NA, "", NULL)]
        DATA[DATA$phone == phone, ] <- df
    }
}
user_139303890

The original data.table solution (see the bottom of the post for a more performant implementation):

library(data.table)

dt <- data.table(phone = c("1234","1234","1234","4567","4567","4567","4567","4567"),
                 sgroup = c("","Jones","","Smith","","Smith","Williams","Jones"))
dt[, ngrp := .(.(unique(sgroup[sgroup != ""]))), by = "phone"][lengths(ngrp) == 1, sgroup := unlist(ngrp)][, 1:2]
#>    phone   sgroup
#> 1:  1234    Jones
#> 2:  1234    Jones
#> 3:  1234    Jones
#> 4:  4567    Smith
#> 5:  4567         
#> 6:  4567    Smith
#> 7:  4567 Williams
#> 8:  4567    Jones

This works by adding a helper column ngrp. For each unique phone value, it creates a list containing a vector of unique sgroup values. (.( is data.table shorthand for list). That list gets stored in ngrp.

dt[, ngrp := .(.(unique(sgroup[sgroup != ""]))), by = "phone"]; dt
#>    phone   sgroup                 ngrp
#> 1:  1234                         Jones
#> 2:  1234    Jones                Jones
#> 3:  1234                         Jones
#> 4:  4567    Smith Smith,Williams,Jones
#> 5:  4567          Smith,Williams,Jones
#> 6:  4567    Smith Smith,Williams,Jones
#> 7:  4567 Williams Smith,Williams,Jones
#> 8:  4567    Jones Smith,Williams,Jones

For the subset of dt where the length of the vector in ngrp is 1, set sgroup to the corresponding value stored in ngrp (use unlist to avoid the warning message about list to character type conversion).

dt[lengths(ngrp) == 1, sgroup := unlist(ngrp)]; dt
#>    phone   sgroup                 ngrp
#> 1:  1234    Jones                Jones
#> 2:  1234    Jones                Jones
#> 3:  1234    Jones                Jones
#> 4:  4567    Smith Smith,Williams,Jones
#> 5:  4567          Smith,Williams,Jones
#> 6:  4567    Smith Smith,Williams,Jones
#> 7:  4567 Williams Smith,Williams,Jones
#> 8:  4567    Jones Smith,Williams,Jones

Subset on the first two columns.

dt[, 1:2]
#>    phone   sgroup
#> 1:  1234    Jones
#> 2:  1234    Jones
#> 3:  1234    Jones
#> 4:  4567    Smith
#> 5:  4567         
#> 6:  4567    Smith
#> 7:  4567 Williams
#> 8:  4567    Jones

Alternatively, drop the helper column.

dt[, ngrp := NULL]; dt
#>    phone   sgroup
#> 1:  1234    Jones
#> 2:  1234    Jones
#> 3:  1234    Jones
#> 4:  4567    Smith
#> 5:  4567         
#> 6:  4567    Smith
#> 7:  4567 Williams
#> 8:  4567    Jones

A faster solution would be to do the clean-up in a function that can be called by phone group. This runs about twice as fast by avoiding the helper column.

fCleanGroup <- function(x) {
  xu <- unique(x[nchar(x) != 0L])
  if (length(xu) == 1L) xu else x
}

dt[, sgroup := fCleanGroup(sgroup), by = "phone"]

microbenchmark::microbenchmark(fun = copy(dt)[, sgroup := fCleanGroup(sgroup), by = "phone"],
                               lst = copy(dt)[, ngrp := .(.(unique(sgroup[sgroup != ""]))), by = "phone"][lengths(ngrp) == 1, sgroup := unlist(ngrp)][, 1:2],
                               copy(dt))
#> Unit: microseconds
#>      expr    min      lq     mean  median      uq    max neval
#>       fun  485.8  595.75  653.372  616.05  680.00 1164.2   100
#>       lst 1058.4 1256.75 1383.188 1302.90 1425.35 3685.1   100
#>  copy(dt)   11.9   21.10   27.425   27.65   31.00   62.6   100
user_94634890
Related