Geek Answers Handbook

Highlight and transform text string in R

This data frame df1looks really similar to what I work with in real life (two columns):

df1 <- data.frame(provider = c("LeBron James, MD",
                          "Peyton Manning, DDS",
                          "Mike Trout, DO"),
             cpt_codes = c("This provider because he bills CPT codes 99284, 99282 and 99285 65% more than his peer group",
                           "Overutilization of visits per patient for E0781-RR-59 and J1100!",
                           "High units per patient compared to the specialty for the following:29581: 146.88% 93990: 33.71%"))

print(df1)
#             provider                                                                                       cpt_codes
#1    LeBron James, MD    This provider because he bills CPT codes 99284, 99282 and 99285 65% more than his peer group
#2 Peyton Manning, DDS                                Overutilization of visits per patient for E0781-RR-59 and J1100!
#3      Mike Trout, DO High units per patient compared to the specialty for the following:29581: 146.88% 93990: 33.71%

I need to extract all character blocks from a field cpt_codesthat are 5 (alphanumeric) characters in length and end with a number (0: 9). Then I need to map them to a field providercontaining a unique string for each combination of / cpt _code providers. The end result is as follows:

#             provider cpt_codes
#1    LeBron James, MD     99284
#2    LeBron James, MD     99282
#3    LeBron James, MD     99285
#4 Peyton Manning, DDS     E0781
#5 Peyton Manning, DDS     J1100
#6      Mike Trout, DO     29581
#7      Mike Trout, DO     93990

, stackoverflow R, . , , . , - "" .

library(stringr)
#replace all punctuation with spaces in the text strings
df1$cpt_codes <- str_replace_all(df1$cpt_codes, "[[:punct:]]", " ")

#identifies all 5 character blocks in the text strings
t <- str_extract_all(df1$cpt_codes, "\\b[a-zA-Z0-9]{5,5}\\b")

#makes a new data frame that keeps only the 5 character blocks ending in a numeric char
fn <- c(0:9)
cpts <- function(x) {
  t1 <- subset(t[[x]], grepl(paste(fn, collapse = "|"), substr(t[[x]], 5, 5)) == TRUE)
  data.frame(id = rep(x, length(t1)), cpt_codes = t1)
}
t2 <- do.call("rbind", (lapply(c(1:length(t)), function(x) cpts(x))))

#creates an "id" field on the df1
df1$id <- c(1:nrow(df1))
df3 <- df1[, -2]

final <- merge(df3, t2, by = "id")
final[, -1]

print(final)
#            provider cpt_codes
#1    LeBron James, MD     99284
#2    LeBron James, MD     99282
#3    LeBron James, MD     99285
#4 Peyton Manning, DDS     E0781
#5 Peyton Manning, DDS     J1100
#6      Mike Trout, DO     29581
#7      Mike Trout, DO     93990
+4
3

\\b\\w{4}\\d\\b, , , [[:punct:]] , .

library(dplyr); library(tidyr); library(stringr)
df1 %>% mutate(cpt_codes = str_extract_all(cpt_codes, "\\b\\w{4}\\d\\b")) %>% unnest()

#              provider cpt_codes
# 1    LeBron James, MD     99284
# 2    LeBron James, MD     99282
# 3    LeBron James, MD     99285
# 4 Peyton Manning, DDS     E0781
# 5 Peyton Manning, DDS     J1100
# 6      Mike Trout, DO     29581
# 7      Mike Trout, DO     93990
+3

R gregexpr() regmatches() :

cn <- 'cpt_codes';
m <- regmatches(df1[[cn]],gregexpr('[a-zA-Z0-9]{4}[0-9]',as.character(df1[[cn]])));
res <- df1[rep(seq_along(m),lengths(m)),setdiff(names(df1),cn),drop=F];
res[[cn]] <- unlist(m);
res;
##                provider cpt_codes
## 1      LeBron James, MD     99284
## 1.1    LeBron James, MD     99282
## 1.2    LeBron James, MD     99285
## 2   Peyton Manning, DDS     E0781
## 2.1 Peyton Manning, DDS     J1100
## 3        Mike Trout, DO     29581
## 3.1      Mike Trout, DO     93990
+2

data.table soln

df1 <- data.frame(provider = c("LeBron James, MD",
                               "Peyton Manning, DDS",
                               "Mike Trout, DO"),
                  cpt_codes = c("This provider because he bills CPT codes 99284, 99282 and 99285 65% more than his peer group",
                                "Overutilization of visits per patient for E0781-RR-59 and J1100!",
                                "High units per patient compared to the specialty for the following:29581: 146.88% 93990: 33.71%"))



    require(data.table)
     ddt <- as.data.table(df1)
    > library(stringr)
    > ddt[,str_extract_all(cpt_codes, "\\b\\w{4}\\d\\b"),provider]
                  provider    V1
    1:    LeBron James, MD 99284
    2:    LeBron James, MD 99282
    3:    LeBron James, MD 99285
    4: Peyton Manning, DDS E0781
    5: Peyton Manning, DDS J1100
    6:      Mike Trout, DO 29581
    7:      Mike Trout, DO 93990
+2

More articles:


All Articles