R/ReverseTransliterate.R

In PersianStemmer: Persian Stemmer for Text Analysis

ReverseTransliterate <-
function(texts){
  txts <- unlist(strsplit(texts, ""))
  # The alphabet 
  txts <- sapply(txts, gsub, pattern='A', replacement='\u0622')
  txts <- sapply(txts, gsub, pattern='a', replacement='\u0627')
  txts <- sapply(txts, gsub, pattern='b', replacement='\u0628')
  txts <- sapply(txts, gsub, pattern='p', replacement='\u067E')
  txts <- sapply(txts, gsub, pattern='t', replacement='\u062a')
  txts <- sapply(txts, gsub, pattern='U', replacement='\u062b')
  txts <- sapply(txts, gsub, pattern='J', replacement='\u062c')
  txts <- sapply(txts, gsub, pattern='C', replacement='\u0686')
  txts <- sapply(txts, gsub, pattern='H', replacement='\u062d')
  txts <- sapply(txts, gsub, pattern='K', replacement='\u062e')
  txts <- sapply(txts, gsub, pattern='d', replacement='\u062f')
  txts <- sapply(txts, gsub, pattern='Z', replacement='\u0630')
  txts <- sapply(txts, gsub, pattern='r', replacement='\u0631')
  txts <- sapply(txts, gsub, pattern='z', replacement='\u0632')
  txts <- sapply(txts, gsub, pattern='j', replacement='\u0698')
  txts <- sapply(txts, gsub, pattern='s', replacement='\u0633')
  txts <- sapply(txts, gsub, pattern='W', replacement='\u0634')
  txts <- sapply(txts, gsub, pattern='S', replacement='\u0635')
  txts <- sapply(txts, gsub, pattern='X', replacement='\u0636')
  txts <- sapply(txts, gsub, pattern='T', replacement='\u0637')
  txts <- sapply(txts, gsub, pattern='x', replacement='\u0638')
  txts <- sapply(txts, gsub, pattern='E', replacement='\u0639')
  txts <- sapply(txts, gsub, pattern='g', replacement='\u063a')
  txts <- sapply(txts, gsub, pattern='f', replacement='\u0641')
  txts <- sapply(txts, gsub, pattern='Q', replacement='\u0642')
  txts <- sapply(txts, gsub, pattern='k', replacement='\u06A9')
  txts <- sapply(txts, gsub, pattern='G', replacement='\u06AF')
  txts <- sapply(txts, gsub, pattern='l', replacement='\u0644')
  txts <- sapply(txts, gsub, pattern='m', replacement='\u0645')
  txts <- sapply(txts, gsub, pattern='n', replacement='\u0646')
  txts <- sapply(txts, gsub, pattern='v', replacement='\u0648')
  txts <- sapply(txts, gsub, pattern='h', replacement='\u0647')
  txts <- sapply(txts, gsub, pattern='i', replacement='\u06CC')
  
  # Numbers
  txts <- sapply(txts, gsub, pattern='1', replacement='\u06f1')
  txts <- sapply(txts, gsub, pattern='2', replacement='\u06f2')
  txts <- sapply(txts, gsub, pattern='3', replacement='\u06f3')
  txts <- sapply(txts, gsub, pattern='4', replacement='\u06f4')
  txts <- sapply(txts, gsub, pattern='5', replacement='\u06f5')
  txts <- sapply(txts, gsub, pattern='6', replacement='\u06f6')
  txts <- sapply(txts, gsub, pattern='7', replacement='\u06f7')
  txts <- sapply(txts, gsub, pattern='8', replacement='\u06f8')
  txts <- sapply(txts, gsub, pattern='9', replacement='\u06f9')
  txts <- sapply(txts, gsub, pattern='0', replacement='\u06f0')
  texts <- paste(txts, collapse="")
  Encoding(texts) <- "UTF-8"
  return(texts)
}