If strings of two dataframes match print rowname - r

Question

I want to print the rownames of a dataframe as vector if it matches a string of another dataframe.
I made a thesaurus with synonyms that looks like this
Synonym Synonym2 Synonym3
0010 01 beobachten U
0030 hkp <NA> <NA>
0040 hkp <NA> <NA>
0050 <NA> <NA> <NA>
0060 <NA> <NA> <NA>
0065 <NA> <NA> <NA>
0070 vipr perk <NA>
0080 oberfl anästh anästh <NA>
0090 vest inj vest inj inj sept blau
0100 l1 <NA> <NA>
0110 <NA> üz <NA>
0120 <NA> <NA> <NA>
1000 gezeigt zu achten putzdruck mhu
and I have a second dataframe:
PKV_clean
ID Aufzeichnungen
1 1 scharfkantig
2 1 t
3 1 aht 36 üz distal
4 1 seit paartagen
5 1 36 vipr
6 1 perk
7 1 üz bilfuird
8 1
9 1
10 1 knirscht
11 1 schiene empohlen
12 1 meldet
and it should print the rownames of the thesaurus when matching any string of a row (Synonym) with the second dataframe.
For example it should print (0070,0110) because Synonym "vipr" of 0070 and Synonym2 "üz" of 0110 matches with the second dataframe.
I tried it with:
#Sure things
a <- thesaurus[grep(PKV_clean$Aufzeichnungen,rownames(thesaurus))]
but this didn't work.
I have also tried creating a separate number for each case and create a 0|1 matrix. This works fine but with over 500 entries this is a lot of manual work.
PKV$"0070" = 0
PKV$"0070"[grepl("vipr | perk",PKV$Aufzeichnungen)] = 1
PKV$"0110" = 0
PKV$"0110"[grepl("üz",PKV$Aufzeichnungen)] = 1
output <- PKV|>
select(where(is.numeric)) |>
select(where(~ sum(.) > 0)) |>
names()
Thank you for your help!
#Mohammed Desouky
if I use the hole Dictionary with your code I get as output:
Edit 2:
dput(head(thesaurus , 40))
structure(list(Synonym = c("01", "hkp", "hkp", NA, NA, NA, "vipr",
"oberfl anästh", "vest inj", "l1", NA, NA, "gezeigt zu achten",
NA, NA, NA, "pzr", NA, "duraphat aufgetragen", NA, "bmf blutstillung",
NA, "fllg", "f1", "f2", "f2 sät", "f3", "mdv", "f4", NA, NA,
NA, NA, NA, NA, "st", NA, "metallprimer oberfläche", NA, NA),
Synonym2 = c("beobachten", NA, NA, NA, NA, NA, "perk", "anästh",
"vest inj", NA, NA, NA, "putzdruck", NA, NA, NA, "psi sbi api",
NA, "empfindliche stelle aufgetragen", NA, "cp", NA, "fllng",
NA, "fllng 2", "tetric flow", "fllg 3", NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, "monobond plus behandelt", NA, NA), Synonym3 = c("U",
NA, NA, NA, NA, NA, NA, NA, "inj sept blau", NA, NA, NA,
"mhu", NA, NA, NA, "dentalhygiene", NA, "üz", NA, "blutstillung",
NA, "f1", NA, "fllg 2", NA, "fllng 3", NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA), Synonym4 = c(NA, NA, NA,
NA, NA, NA, NA, NA, "cx pulpennah", NA, NA, NA, "gezeigt",
NA, NA, NA, NA, NA, "duraphat", NA, "bmf", NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA
), Synonym5 = c(NA, NA, NA, NA, NA, NA, NA, NA, "infiltration",
NA, NA, NA, "pat gezeigt", NA, NA, NA, NA, NA, NA, NA, "visco gel",
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA), Synonym6 = c(NA, NA, NA, NA, NA, NA, NA,
NA, "injektion", NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA), Synonym7 = c(NA, NA, NA, NA, NA,
NA, NA, NA, "infil", NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA), Synonym8 = c(NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_), Synonym9 = c(NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_)), row.names = c("0010",
"0030", "0040", "0050", "0060", "0065", "0070", "0080", "0090",
"0100", "0110", "0120", "1000", "1010", "1020", "1030", "1040",
"2000", "2010", "2020", "2030", "2040", "2050", "2060", "2070",
"2080", "2090", "2100", "2110", "2120", "2130", "2150", "2160",
"2170", "2180", "2190", "2195", "2197", "2200", "2210"), class = "data.frame")```
Can you work with this?

Answer 1

Try this
Synonym <- c()
for(i in 1:nrow(PKV_clean)){
s <- gsub("\\s+" , "|" , PKV_clean$Aufzeichnungen[i])
if(nchar(s) > 1){
ind <- rowSums(sapply(thesaurus , \(x) grepl(s , x)
))
} else ind <- rep(0 , nrow(thesaurus))
a <- which(ind >= 1)
if(length(a) > 0) ans <- toString(rownames(thesaurus)[a]) else ans <- ""
Synonym <- c(Synonym , ans)
}
PKV_clean$Synonym <- Synonym
output
ID Aufzeichnungen Synonym
1 1 scharfkantig
2 1 t
3 1 aht 36 üz distal 0110
4 1 seit paartagen
5 1 36 vipr 0070
6 1 perk 0070
7 1 üz bilfuird 0110
8 1
9 1
10 1 knirscht
11 1 schiene empohlen
12 1 meldet