Des fonctions pour faire de l’analyse textuelle sous R

Utilisation d’anatext

Avec un fichier texte :
t<-anatext(textfile="d:/monrep/proust.txt")
t$wordnb

Avec une variable textuelle :
t<-anatext(base$vartext)
t$wordnb

Options :

x:

Variable textuelle à analyser.
Défaut : NULL

textfile :

Indication du fichier texte (.txt) à analyser.
Défaut : NULL

sep :

Indicateur du séparateur de ligne dans le fichier txt.
Défaut : " "

septxt :

Si vous avez plusieurs textes à comparer, il existe désormais une nouvelle options : septxt="" où vous indiquez votre séparateur de texte (que vous aurez utilisé préalablement dans votre fichier pour séparer vos textes). Le mieux est de mettre une suite de caractère comme "$$$" ou "###" qui n’est pas constituée de signes de ponctuation (déjà éliminés) et qui n’est pas présent dans votre fichier. La casse, est la casse finale (tout en majuscule par défaut). Cette variable permet la construction d’une variable de numérotation des textes t$text$numtxt dans le tableau lexical entier.
Défaut : NULL

upcase :

Texte mis en majuscule.
Défaut: TRUE

del.punctuation:

Suppression de la ponctuation.
Défaut: TRUE

del.accents:

Suppression des accents.
Défaut: TRUE

keep

Conserver une variable de la base de données
Défaut: NULL

max.merge.size=50000

Taille maximale du tableau lexical entier pour laquelle on refusionne pour chaque mot sa fréquence dans le corpus.

CODE DES FONCTIONS

simplelag <-function(x,mylag=1,outside=NA)
{
myend<-length(x)- mylag
y<-c(replicate(mylag,outside),x[1:myend])
}

forward<-function(x,myforward=1,outside=NA)
{
mystart<-myforward+1
y<-c(x[mystart:length(x)],replicate(myforward,outside))
}

anatext <- function (x,textfile=NULL,sep="\n",upcase=TRUE,del.punctuation=TRUE,
del.accents=TRUE,keep=NULL,max.merge.size=50000) {
if (!is.null(textfile))
{
tfile<-as.data.frame(scan(file=textfile,sep=sep,what=list(word="")))
x<-tfile$word
}

VARTEXT <- chartr("\"“”‘’","««»''",x)

if (upcase==TRUE)
{
VARTEXT<-toupper(VARTEXT)
}
if (del.accents==TRUE)
{
VARTEXT <- chartr("ÀÂÄÉÊÈËÇÎÏÔÖÛÜÙàâäéêèëçîïôöûüù",
"AAAEEEECIIOOUUUaaaeeeeciioouuu", VARTEXT)
}
if (del.punctuation==FALSE)
{
VARTEXT <- gsub("(['().,;:!?«»—–…/])", " \\1 ", VARTEXT)
VARTEXT <- gsub("\\[", " [ ", VARTEXT)
VARTEXT <- gsub("\\]", " ] ", VARTEXT)
VARTEXT <- gsub("-", " - ", VARTEXT)

}
if (del.punctuation==TRUE)
{
VARTEXT <- gsub("(['().,;:!?«»—–…/])", " ", VARTEXT)
VARTEXT <- gsub("\\[", " ", VARTEXT)
VARTEXT <- gsub("\\]", " ", VARTEXT)
VARTEXT <- gsub("-", " ", VARTEXT)
}
VARTEXT <- gsub("  ", " ", VARTEXT)

names(VARTEXT) <- paste(1:length(VARTEXT),"#")
VARTEXT <- sapply(VARTEXT,strsplit, " ")

TLE <- unlist(VARTEXT)
TLE <- data.frame(id=substr(names(TLE),1,regexpr("#",names(TLE))-1),
idorder=substr(names(TLE),regexpr("#",names(TLE))+1,nchar(names(TLE))),
words=TLE)

TLE$id<-as.numeric(as.character(TLE$id))
TLE$idorder<-as.numeric(as.character(TLE$idorder))

TLE$words<-as.character(TLE$words)

TLE$id==simplelag(TLE$id)

TLE$lid=simplelag(TLE$id,outside=0)
TLE$fid=forward(TLE$id,outside=0)

TLE$segment2<-paste(simplelag(TLE$words),TLE$words)
TLE$segment3<-paste(TLE$segment2,forward(TLE$words))

TLE$segment2[TLE$lid != TLE$id ]<-NA
TLE$segment3[TLE$fid != TLE$id | TLE$lid != TLE$id]<-NA

WORDCOUNT<-table(TLE$words)
WORDCOUNT<-data.frame(WORDCOUNT)
WORDCOUNT$nchar<-nchar(as.character(WORDCOUNT$Var1))
WORDCOUNT<-WORDCOUNT[order(WORDCOUNT$Freq),]

SEGM2COUNT<-table(TLE$segment2)
SEGM2COUNT<-data.frame(SEGM2COUNT)
SEGM2COUNT<-SEGM2COUNT[order(SEGM2COUNT$Freq),]

SEGM3COUNT<-table(TLE$segment3)
SEGM3COUNT<-data.frame(SEGM3COUNT)
SEGM3COUNT<-SEGM3COUNT[order(SEGM3COUNT$Freq),]

if (length(TLE$words)<max.merge.size)
{
TLE<-merge(TLE,WORDCOUNT,by.x="words",by.y="Var1")
}

if (!is.null(keep))
{
KEEP<-as.data.frame(keep)
KEEP$one<-1
KEEP$mergid<-cumsum(KEEP$one)

TLE<-merge(TLE,KEEP,by.x="id",by.y="mergid")
}

TLE$nchar<-nchar(TLE$words)

TLE<-TLE[order(TLE$id,TLE$idorder),]

TLE<-TLE[,-which(names(TLE) %in% c("lid","fid"))]

structure(list(text=TLE,wordnb=WORDCOUNT,s2nb=SEGM2COUNT,s3nb=SEGM3COUNT))
}


wordcount <- function (pattern,x,dich=FALSE,upcase=TRUE,del.punctuation=FALSE,del.accents=FALSE,keep=NULL) {

if (substr(pattern,1,1)!="*")
{pattern<-paste(" ",pattern,sep="")}
else {
pattern<-substr(pattern,2,nchar(pattern))
}
if (substr(pattern,nchar(pattern),nchar(pattern))!="*")
{pattern<-paste(pattern," ",sep="")}
else {
pattern<-substr(pattern,1,nchar(pattern)-1)
}

VARTEXT <- paste(" ",chartr("\"“”‘’","««»''",x)," ",sep="")

if (upcase==TRUE)
{
VARTEXT<-toupper(VARTEXT)
}
if (del.accents==TRUE)
{
VARTEXT <- chartr("ÀÂÄÉÊÈËÇÎÏÔÖÛÜÙàâäéêèëçîïôöûüù",
"AAAEEEECIIOOUUUaaaeeeeciioouuu", VARTEXT)
}
if (del.punctuation==FALSE)
{
VARTEXT <- gsub("(['().,;:!?«»—–…/])", " \\1 ", VARTEXT)
VARTEXT <- gsub("\\[", " [ ", VARTEXT)
VARTEXT <- gsub("\\]", " ] ", VARTEXT)
VARTEXT <- gsub("-", " - ", VARTEXT)
}
if (del.punctuation==TRUE)
{
VARTEXT <- gsub("(['().,;:!?«»—–…/])", " ", VARTEXT)
VARTEXT <- gsub("\\[", " ", VARTEXT)
VARTEXT <- gsub("\\]", " ", VARTEXT)
VARTEXT <- gsub("-", " ", VARTEXT)
}
if (dich==TRUE)
{
((nchar(VARTEXT)-nchar(gsub(pattern, "", VARTEXT)))/nchar(pattern)>0)*1
}

else
{
(nchar(VARTEXT)-nchar(gsub(pattern, "", VARTEXT)))/nchar(pattern)
}
}