Replace data entry errors with the most common value - dplyr

Viewed 100

I have a data frame which contains some data entry errors.

I wish to replace these outlier values per group with the most common value per group.

My data looks as follows:

df <- data.frame(CODE = c("J1745","J1745","J1745","J1745","J1100","J1100","J1100","J1100","J1100","J1100"),NDC = c(1234,1234,1234,1234,5678,5678,5678,5678,5678,5678),DOSAGE = c("10ML","10 ML","10 ML","10 ML","5 ML","5 ML","5 ML","5 ML","50 ML","5 ML"),DESC = c("TEXT1","TEXT 1","TEXT 1","TEXT 1","TEXT 2","TEXT 2","TEXT 2","TEXT 2","TEXT 10","TEXT 2"))

enter image description here

As you can see my DOSAGE and DESC columns contain some inconsistencies and I would like to replace them with the most common value within each group.

My desired output looks as follows:

enter image description here

2 Answers

I agree with the comment that this is potentially dangerous.

The code below replaces elements that have <= a specified number of occurrences with the most common value. I use base-R machinery within the replacement function because that's what I know how to do.

repl_common <- function(x,n=1) {
    tt <- tapply(x,x,length)          ## count number of instances
    m <- names(tt)[which.max(tt)]     ## find mode
    x[tt[as.character(x)]<=n] <- m    ## replace
    return(x)
}
## apply by group across specified columns
df %>% group_by(CODE) %>% mutate(across(c(DOSAGE,DESC), repl_common))

You can use the Mode function from here to get the most common value.

Mode <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}

Apply this function by group.

library(dplyr)
df %>% group_by(CODE, NDC) %>% mutate(across(c(DOSAGE, DESC), Mode)) %>% ungroup

#    CODE    NDC DOSAGE DESC  
#   <chr> <dbl> <chr>  <chr> 
# 1 J1745  1234 10 ML  TEXT 1
# 2 J1745  1234 10 ML  TEXT 1
# 3 J1745  1234 10 ML  TEXT 1
# 4 J1745  1234 10 ML  TEXT 1
# 5 J1100  5678 5 ML   TEXT 2
# 6 J1100  5678 5 ML   TEXT 2
# 7 J1100  5678 5 ML   TEXT 2
# 8 J1100  5678 5 ML   TEXT 2
# 9 J1100  5678 5 ML   TEXT 2
#10 J1100  5678 5 ML   TEXT 2 
Related