|
Mineração de Texto
|
Distribuições, leis e riqueza em texto
Prof. Walmes M. Zeviani
2019-02-26
1 Lei de Zipf
A frequência de uma palavra, \(f(w)\), é uma função não linear decrescente do rank da palavra, \(r(w)\), em um corpus. Ou seja, \[ f(w) = \dfrac{C}{r(w)^a}, \] em que C é uma constante específica para o corpus, geralmente é a frequência da palavra mais frequente, e a \(a\) é um parâmetro de forma da relação.
A seguir tem-se o gráfico da distribuição conforme estabelecido pela lei de Zipf.
#-----------------------------------------------------------------------
# Cálculo.
r_w <- 1:100
a <- 0.9
cons <- 300
f_w <- cons * r_w^(-a)
f_w <- f_w/sum(f_w)
plot(f_w ~ r_w, type = "h", ylim = c(0, max(f_w)),
xlab = "rank(w)",
ylab = "freq(w)")
# Relação linear no log-log.
plot(log(f_w) ~ log(r_w),
xlab = "rank(w)",
ylab = "freq(w)")
A seguir a lei de Zipf será avaliada usando conjuntos de dados reais. Os textos são dos evangelhos do novo testamento que foram extraídos com web scraping do site https://www.bibliaon.com/.
#-----------------------------------------------------------------------
# Carregando versículos dos 4 evangelhos.
# Carrega dados extraídos da web.
load("../data/evang.RData")
str(evang)## List of 4
## $ Mateus: chr [1:1071] "Registro da genealogia de Jesus Cristo, filho de Davi, filho de Abraão:" "Abraão gerou Isaque; Isaque gerou Jacó; Jacó gerou Judá e seus irmãos;" "Judá gerou Perez e Zerá, cuja mãe foi Tamar; Perez gerou Esrom; Esrom gerou Arão;" "Arão gerou Aminadabe; Aminadabe gerou Naassom; Naassom gerou Salmom;" ...
## $ Marcos: chr [1:678] "Princípio do evangelho de Jesus Cristo, o Filho de Deus." "Conforme está escrito no profeta Isaías: \"Enviarei à tua frente o meu mensageiro; ele preparará o teu caminho\"" "\"voz do que clama no deserto: 'Preparem o caminho para o Senhor, façam veredas retas para ele' \"." "Assim surgiu João, batizando no deserto e pregando um batismo de arrependimento para o perdão dos pecados." ...
## $ Lucas : chr [1:1151] "Muitos já se dedicaram a elaborar um relato dos fatos que se cumpriram entre nós," "conforme nos foram transmitidos por aqueles que desde o início foram testemunhas oculares e servos da palavra." "Eu mesmo investiguei tudo cuidadosamente, desde o começo, e decidi escrever-te um relato ordenado, ó excelentíssimo Teófilo," "para que tenhas a certeza das coisas que te foram ensinadas." ...
## $ João : chr [1:879] "No princípio era aquele que é a Palavra. Ele estava com Deus e era Deus." "Ele estava com Deus no princípio." "Todas as coisas foram feitas por intermédio dele; sem ele, nada do que existe teria sido feito." "Nele estava a vida, e esta era a luz dos homens." ...# Os primeiros versículos de cada evangelho.
lapply(evang, head, n = 3)## $Mateus
## [1] "Registro da genealogia de Jesus Cristo, filho de Davi, filho de Abraão:"
## [2] "Abraão gerou Isaque; Isaque gerou Jacó; Jacó gerou Judá e seus irmãos;"
## [3] "Judá gerou Perez e Zerá, cuja mãe foi Tamar; Perez gerou Esrom; Esrom gerou Arão;"
##
## $Marcos
## [1] "Princípio do evangelho de Jesus Cristo, o Filho de Deus."
## [2] "Conforme está escrito no profeta Isaías: \"Enviarei à tua frente o meu mensageiro; ele preparará o teu caminho\""
## [3] "\"voz do que clama no deserto: 'Preparem o caminho para o Senhor, façam veredas retas para ele' \"."
##
## $Lucas
## [1] "Muitos já se dedicaram a elaborar um relato dos fatos que se cumpriram entre nós,"
## [2] "conforme nos foram transmitidos por aqueles que desde o início foram testemunhas oculares e servos da palavra."
## [3] "Eu mesmo investiguei tudo cuidadosamente, desde o começo, e decidi escrever-te um relato ordenado, ó excelentíssimo Teófilo,"
##
## $João
## [1] "No princípio era aquele que é a Palavra. Ele estava com Deus e era Deus."
## [2] "Ele estava com Deus no princípio."
## [3] "Todas as coisas foram feitas por intermédio dele; sem ele, nada do que existe teria sido feito."# Para passa caixa baixa
evang <- lapply(evang, tolower)Os gráficos a seguir mostram a adequação da lei de Zipf para o evangelho escolhido para a análise.
#-----------------------------------------------------------------------
# Fragmentar texto nos espaços, pontuação, etc.
library(tidyverse)
library(tidytext)
text_df <- tibble(verso = seq_along(evang$Mateus),
text = evang$Mateus)
str(text_df)## Classes 'tbl_df', 'tbl' and 'data.frame': 1071 obs. of 2 variables:
## $ verso: int 1 2 3 4 5 6 7 8 9 10 ...
## $ text : chr "registro da genealogia de jesus cristo, filho de davi, filho de abraão:" "abraão gerou isaque; isaque gerou jacó; jacó gerou judá e seus irmãos;" "judá gerou perez e zerá, cuja mãe foi tamar; perez gerou esrom; esrom gerou arão;" "arão gerou aminadabe; aminadabe gerou naassom; naassom gerou salmom;" ...tidy_text <- unnest_tokens(text_df, word, text)
str(tidy_text)## Classes 'tbl_df', 'tbl' and 'data.frame': 20652 obs. of 2 variables:
## $ verso: int 1 1 1 1 1 1 1 1 1 1 ...
## $ word : chr "registro" "da" "genealogia" "de" ...freq <- tidy_text %>%
count(word) %>%
arrange(-n)
freq## # A tibble: 3,163 x 2
## word n
## <chr> <int>
## 1 e 936
## 2 o 777
## 3 que 681
## 4 a 603
## 5 de 514
## 6 os 385
## 7 se 343
## 8 não 298
## 9 do 258
## 10 vocês 254
## # ... with 3,153 more rowsplot(n ~ seq(word), data = freq[1:300, ])
plot(n ~ seq(word), data = freq[1:300, ], log = "xy")
Será que a lei de Zipf é uma distribuição que se ajusta bem aos dados? Como você poderia avaliar de há boa qualidade de ajuste da lei considerando os dados apresentados?
2 Lei de Heaps
Usando os mesmos dados será investigada a adequação da lei de Heaps. Para isso será formado grupos de versículos de forma aleatória.
# Cria os grupos de versículos.
text_df <- text_df %>%
mutate(doc = sample(1:30, size = n(), replace = TRUE))
str(text_df)## Classes 'tbl_df', 'tbl' and 'data.frame': 1071 obs. of 3 variables:
## $ verso: int 1 2 3 4 5 6 7 8 9 10 ...
## $ text : chr "registro da genealogia de jesus cristo, filho de davi, filho de abraão:" "abraão gerou isaque; isaque gerou jacó; jacó gerou judá e seus irmãos;" "judá gerou perez e zerá, cuja mãe foi tamar; perez gerou esrom; esrom gerou arão;" "arão gerou aminadabe; aminadabe gerou naassom; naassom gerou salmom;" ...
## $ doc : int 23 20 30 15 27 13 1 8 19 9 ...# Faz a tokenização por documento.
un_tk <- text_df %>%
group_by(doc) %>%
unnest_tokens(word, text)
un_tk## # A tibble: 20,652 x 3
## # Groups: doc [30]
## verso doc word
## <int> <int> <chr>
## 1 1 23 registro
## 2 1 23 da
## 3 1 23 genealogia
## 4 1 23 de
## 5 1 23 jesus
## 6 1 23 cristo
## 7 1 23 filho
## 8 1 23 de
## 9 1 23 davi
## 10 1 23 filho
## # ... with 20,642 more rows# Determina o tamanho do documento por documento.
n_tot <- un_tk %>%
count(doc)
n_tot## # A tibble: 30 x 2
## # Groups: doc [30]
## doc n
## <int> <int>
## 1 1 868
## 2 2 594
## 3 3 333
## 4 4 574
## 5 5 450
## 6 6 1036
## 7 7 797
## 8 8 569
## 9 9 626
## 10 10 755
## # ... with 20 more rows# Faz a contagem dos termos distintos (vocabulário) por documento.
n_uniq <- un_tk %>%
distinct() %>%
summarise(u = n())
n_uniq## # A tibble: 30 x 2
## doc u
## <int> <int>
## 1 1 758
## 2 2 542
## 3 3 292
## 4 4 517
## 5 5 406
## 6 6 936
## 7 7 704
## 8 8 513
## 9 9 546
## 10 10 685
## # ... with 20 more rowssum(n_tot$n)## [1] 20652sum(n_uniq$u)## [1] 18445# Junta as duas tabelas.
heaps <- full_join(n_uniq, n_tot)## Joining, by = "doc"heaps## # A tibble: 30 x 3
## doc u n
## <int> <int> <int>
## 1 1 758 868
## 2 2 542 594
## 3 3 292 333
## 4 4 517 574
## 5 5 406 450
## 6 6 936 1036
## 7 7 704 797
## 8 8 513 569
## 9 9 546 626
## 10 10 685 755
## # ... with 20 more rows# Exibe a relação entre as variáveis.
plot(u ~ n, data = heaps)
# Determina o coeficiente da relação.
summary(lm(u ~ n, data = heaps))##
## Call:
## lm(formula = u ~ n, data = heaps)
##
## Residuals:
## Min 1Q Median 3Q Max
## -31.578 -8.129 1.072 10.619 20.851
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.48634 12.16373 -0.204 0.84
## n 0.89675 0.01728 51.882 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 13.84 on 28 degrees of freedom
## Multiple R-squared: 0.9897, Adjusted R-squared: 0.9893
## F-statistic: 2692 on 1 and 28 DF, p-value: < 2.2e-16# Gráfico da relação.
ggplot(data = heaps,
mapping = aes(x = n, y = u)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
xlab("Tamanho do documento") +
ylab("Tamanho do vocabulário")
3 Métricas para diversidade de vocabulário
A densidade lexical é definida por
\[ \text{LD} = 100 n_{\text{lex}}/n_{\text{tot}}, \]
em que \(\text{LD}\) é a densidade lexical calculo pelo quociente entre número de termos únicos ou quantidade de lexicons, \(n_{\text{lex}}\), e número total de termos ou tokens \(n_{\text{tot}}\) [@ashish2016mastering].
n_lex <- length(unique(u)) # Tamanho do vocabulário.
n_tot <- length(u)
c(n_lex, n_tot)
100 * n_lex/n_totA originalidade lexical é o quociente entre o número único de tipos de palavra pelo total de lexicons [@ashish2016mastering].
A sofisticação lexical é a razão entre o número de lexions avançados pelo número de lexicons ordinários [@ashish2016mastering]. A questão aqui é definir o que é um lexicon avançado.
A variação lexical é sobre a quantidade de termos distintos empregados como sinônimos de um mesmo conceito, como biscoito e bolacha, cadeira e assento, carro e veículo. O pacote koRpus tem funções para mensuração da variação lexical [@ashish2016mastering].
4 koRpus
- Endereço no CRAN: https://cran.r-project.org/package=koRpus.
- Vinheta do pacote: https://reaktanz.de/R/pckg/koRpus/koRpus_vignette.html.
library(koRpus)## Loading required package: sylly## For information on available language packages for 'koRpus', run
##
## available.koRpus.lang()
##
## and see ?install.koRpus.lang()##
## Attaching package: 'koRpus'## The following object is masked from 'package:readr':
##
## tokenizels("package:koRpus")## [1] "ARI" "available.koRpus.lang"
## [3] "bormuth" "C.ld"
## [5] "clozeDelete" "coleman"
## [7] "coleman.liau" "correct.tag"
## [9] "cTest" "CTTR"
## [11] "dale.chall" "danielson.bryan"
## [13] "describe" "describe<-"
## [15] "dickes.steiwer" "DRP"
## [17] "ELF" "farr.jenkins.paterson"
## [19] "fixObject" "flesch"
## [21] "flesch.kincaid" "FOG"
## [23] "FORCAST" "freq.analysis"
## [25] "fucks" "get.kRp.env"
## [27] "guess.lang" "harris.jacobson"
## [29] "HDD" "hyphen"
## [31] "hyphen_c" "hyphen_df"
## [33] "install.koRpus.lang" "is.taggedText"
## [35] "jumbleWords" "K.ld"
## [37] "kRp_analysis" "kRp.cluster"
## [39] "kRp_corp_freq" "kRp.filter.wclass"
## [41] "kRp_lang" "kRp.POS.tags"
## [43] "kRp_readability" "kRp_tagged"
## [45] "kRp.text.analysis" "kRp.text.paste"
## [47] "kRp.text.transform" "kRp_TTR"
## [49] "kRp_txt_freq" "kRp_txt_trans"
## [51] "language" "language<-"
## [53] "lex.div" "lex.div.num"
## [55] "linsear.write" "LIX"
## [57] "maas" "MATTR"
## [59] "MSTTR" "MTLD"
## [61] "nWS" "plot"
## [63] "query" "readability"
## [65] "readability.num" "read.BAWL"
## [67] "read.corp.celex" "read.corp.custom"
## [69] "read.corp.LCC" "read.tagged"
## [71] "RIX" "R.ld"
## [73] "segment.optimizer" "set.kRp.env"
## [75] "set.lang.support" "show"
## [77] "S.ld" "SMOG"
## [79] "spache" "strain"
## [81] "summary" "taggedText"
## [83] "taggedText<-" "textFeatures"
## [85] "textTransform" "tif_as_tokens_df"
## [87] "tokenize" "tokens"
## [89] "traenkle.bailer" "treetag"
## [91] "TRI" "TTR"
## [93] "tuldava" "types"
## [95] "U.ld" "wheeler.smith"available.koRpus.lang()## The following language support packages are currently available:
##
## koRpus.lang.en
## koRpus.lang.de
## koRpus.lang.es
## koRpus.lang.fr
## koRpus.lang.it
## koRpus.lang.nl
## koRpus.lang.pt [installed]
## koRpus.lang.ru
##
## To install all missing packages, run:
##
## install.koRpus.lang(c("en", "de", "es", "fr", "it", "nl", "ru"))help(install.koRpus.lang, help_type = "html")
# Instala suplemento de um idioma.
install.koRpus.lang("pt")
library("koRpus.lang.pt")
ls("package:koRpus.lang.pt")apropos("\\.ld$")## [1] "C.ld" "K.ld" "R.ld" "S.ld" "U.ld"# help(lex.div, help_type = "html")
# help(C.ld, help_type = "html")5 languageR
library(languageR)
ls("package:languageR")## [1] "acf.fnc" "affixProductivity"
## [3] "alice" "aovlmer.fnc"
## [5] "auxiliaries" "beginningReaders"
## [7] "collin.fnc" "compare.richness.fnc"
## [9] "corres.fnc" "corsup.fnc"
## [11] "danish" "dative"
## [13] "dativeSimplified" "durationsGe"
## [15] "durationsOnt" "dutchSpeakersDist"
## [17] "dutchSpeakersDistMeta" "english"
## [19] "etymology" "faz"
## [21] "finalDevoicing" "growth2vgc.fnc"
## [23] "growth.fnc" "havelaar"
## [25] "head.growth" "heid"
## [27] "herdan.fnc" "imaging"
## [29] "item.fnc" "items.quasif.fnc"
## [31] "lags.fnc" "latinsquare"
## [33] "lexdec" "lexicalMeasures"
## [35] "lexicalMeasuresClasses" "lmerPlotInt.fnc"
## [37] "make.reg.fnc" "makeSplineData.fnc"
## [39] "moby" "mvrnormplot.fnc"
## [41] "nesscg" "nessdemog"
## [43] "nessw" "oldFrench"
## [45] "oldFrenchMeta" "oz"
## [47] "pairscor.fnc" "periphrasticDo"
## [49] "phylogeny" "plotLMER.fnc"
## [51] "plotlogistic.fit.fnc" "primingHeid"
## [53] "primingHeidPrevRT" "pvals.fnc"
## [55] "quasif" "quasiF.fnc"
## [57] "quasiFsim.fnc" "ratings"
## [59] "regularity" "selfPacedReadingHeid"
## [61] "shadenormal.fnc" "shrinkage"
## [63] "simulateLatinsquare.fnc" "simulateQuasif.fnc"
## [65] "simulateRegression.fnc" "sizeRatings"
## [67] "spanish" "spanishFunctionWords"
## [69] "spanishMeta" "spectrum.fnc"
## [71] "splitplot" "subjects.latinsquare.fnc"
## [73] "subjects.quasif.fnc" "tail.growth"
## [75] "text2spc.fnc" "through"
## [77] "twente" "variationLijk"
## [79] "ver" "verbs"
## [81] "warlpiri" "weightRatings"
## [83] "writtenVariationLijk" "xylowess.fnc"
## [85] "yule.fnc" "zipf.fnc"# help(package = "languageR", help_type = "html")
data(alice)
str(alice)## chr [1:27269] "ALICE" "S" "ADVENTURES" "IN" "WONDERLAND" "Lewis" ...alice[1:5]## [1] "ALICE" "S" "ADVENTURES" "IN" "WONDERLAND"# Gráfico da lei de Zipf com o "Alice no pais das maravilhas".
alice.zipf <- zipf.fnc(alice, plot = TRUE)
head(alice.zipf)## frequency freqOfFreq rank
## 117 1522 1 1
## 116 796 1 2
## 115 721 1 3
## 114 614 1 4
## 113 545 1 5
## 112 527 1 66 zipR
#-----------------------------------------------------------------------
library(zipR)
ls("package:zipR")7 Distâncias entre cadeias de caracteres
library(stringdist)
stringdist("Walmes", "Valmes", method = "lv")## [1] 1stringdist("Walmes", "Valmes", method = "dl")## [1] 1stringdist("Walmes", "Valmes", method = "hamming")## [1] 1stringdist("Walmes", "Valmes", method = "jw")## [1] 0.1111111
Mineração de Texto |
leg.ufpr.br/~walmes/ensino/mintex/ |