Des fonctions pour faire de l'analyse textuelle sous R

La fonction anatext permet de faire un dénombrement des mots, des segments de deux ou trois mots d'une variable textuelle d'une base ou d'un fichier texte. La fonction wordcount permet de compter un mot ou une expression dans une variable textuelle.

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 :

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 : "\n"

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.

Le fichier de script R (pour le jeu de caractère UTF-8)

Il est sans doute plus sûr de télécharger le fichier. Sinon, vous pouvez copier coller le script ci-dessous.

CODE DES FONCTIONS

simplelag <-function(x,by=NULL,mylag=1,outside=NA)
{
myend<-length(x)- mylag
if (!is.null(by)) {
    lby<-c(replicate(mylag,""),as.character(by[1:myend]))
    y0<-c(replicate(mylag,outside),x[1:myend])
    y<-ifelse(as.character(by)==lby,y0,outside)

}
else {
    y<-c(replicate(mylag,outside),x[1:myend])
}
}

forward<-function(x,by=NULL,myforward=1,outside=NA)
{
mystart<-myforward+1
if (!is.null(by)) {
    fby<-c(as.character(by[mystart:length(x)]),replicate(myforward,""))
    y0<-c(x[mystart:length(x)],replicate(myforward,outside))
    y<-ifelse(as.character(by)==fby,y0,outside)
}
else {
    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)
}
}