How do I replace initial (first or last) with a name from another column?-CodePudding

How do I replace initials with full names (if the initial matches the full name in another column)?

I have data that looks like this:

data <- data.frame(name = c("Acorus americanus", "Nothocalais cuspidata", "Elymus repens", "Elymus hmmmm", "Acorus americanus"),
                   synonym = c("A. calamus", "Agoseris cuspidata", "Agropyron r.", "Elymus sp.", "S. americanus"))

                   name            synonym
1     Acorus americanus         A. calamus
2 Nothocalais cuspidata Agoseris cuspidata
3         Elymus repens       Agropyron r.
4          Elymus hmmmm         Elymus sp.
5     Acorus americanus      S. americanus

How can I replace the initial with the name, so I get this?

                   name            synonym
1     Acorus americanus     Acorus calamus
2 Nothocalais cuspidata Agoseris cuspidata
3         Elymus repens   Agropyron repens 
4          Elymus hmmmm         Elymus sp.
5     Acorus americanus      S. americanus

There are also other abbreviations like sp., var. and ssp. that I don't want to change into names, but none of them are single letters. Also I would like to leave the initial if it doesn't match the first letter of a name in another column.

CodePudding user response：

This solutions tests for a shared first letter using stringr::str_extract(), then replaces single-letter abbreviations using stringr::str_replace(). (You could also use base grep() and gsub()).

library(stringr)
library(dplyr)

data %>%
  mutate(
    synonym = if_else(
      str_extract(synonym, "^\\w") == str_extract(name, "^\\w"),
      str_replace(
        synonym,
        "^\\w\\.", 
        str_extract(name, "^\\w ")
      ),
      synonym
    ),
    synonym = if_else(
      str_extract(synonym, "(?<=\\s)\\w") == str_extract(name, "(?<=\\s)\\w"),
      str_replace(
        synonym,
        "\\w\\.$", 
        str_extract(name, "\\w $")
      ),
    synonym
    )
  )

                   name            synonym
1     Acorus americanus     Acorus calamus
2 Nothocalais cuspidata Agoseris cuspidata
3         Elymus repens   Agropyron repens
4          Elymus hmmmm         Elymus sp.
5     Acorus americanus      S. americanus

CodePudding user response：

Another solution:

library(tidyverse)
data %>%
  summarise(read.table(text=t(cur_data())))%>%
  mutate(across(everything(), ~if_else(str_detect(lag(., def=""), .), lag(.), .)))%>%
  unite(result, sep = ' ')%>%
  mutate(rep(names(data), nrow(data)))%>%
  unstack()
 
                  name            synonym
1     Acorus americanus     Acorus calamus
2 Nothocalais cuspidata Agoseris cuspidata
3         Elymus repens   Agropyron repens
4          Elymus hmmmm         Elymus sp.
5     Acorus americanus      S. americanus