- -
Анализ текста
(
http://forum.oszone.net/showthread.php?t=306388)
| Invincible |
07-10-2015 23:28 2561673 |
Анализ текста
Всем привет.
Можете подсказать, можно в Word производить такой анализ текста: разбить текст на слова, посчитать количество повторяющихся слов в тексте, найти пары слов наиболее связанных друг с другом и посчитать их количество?
|
Invincible, можно. Макросом.
Цитата:
Цитата Invincible
пары слов наиболее связанных друг с другом »
|
Что это значит?
|
| Invincible |
08-10-2015 22:38 2562054 |
Пары слов, которые чаще всего встречаются, проще говоря их количество |
| Invincible |
09-10-2015 07:01 2562096 |
А у вас нету такого макроса? А то я в них не силен |
«Пару слов» понимать как стоящие рядом друг с другом? В строгом порядке или произвольном: «мама мыла» и «мыла мама» — это должно числиться как одна пара или как две разных пары?
Цитата:
Цитата Invincible
А у вас нету такого макроса? »
|
Нет. Его надо написать.
Например, для первой части:
Цитата:
Цитата Invincible
разбить текст на слова, посчитать количество повторяющихся слов в тексте, »
|
Код:
Option Explicit
Sub Sample()
Dim objWord As Range
Dim strWord As String
Dim objDictionary As Object
Dim elem As Variant
Set objDictionary = CreateObject("Scripting.Dictionary")
For Each objWord In ThisDocument.Words
strWord = Trim(Replace(objWord.Text, vbCr, ""))
If Not Len(strWord) = 0 Then
If Not objDictionary.Exists(strWord) Then
objDictionary.Add strWord, 1
Else
objDictionary.Item(strWord) = objDictionary.Item(strWord) + 1
End If
End If
Next
For Each elem In objDictionary.Keys
Debug.Print "[" & elem & "]", objDictionary.Item(elem)
Next
End Sub
Надо понимать, что у Word'а своё понимание понятия «слова», оно может быть отличным от Вашего. Например, данная страница может давать такой набор «слов»:
Скрытый текст
Код:
[Invincible] 6
[вне] 2
[форума] 2
[Старожил] 2
[Сообщения] 3
[:] 13
[171] 2
[Благодарности] 3
[1] 2
[ ] 3
[Профиль] 3
[|] 12
[Отправить] 3
[PM] 3
[Цитировать] 3
[Сообщить] 3
[модератору] 3
[Всем] 1
[привет] 1
[.] 3
[Можете] 1
[подсказать] 1
[,] 8
[можно] 2
[в] 2
[Word] 1
[производить] 1
[такой] 1
[анализ] 1
[текста] 1
[разбить] 1
[текст] 1
[на] 2
[слова] 1
[посчитать] 2
[количество] 3
[повторяющихся] 1
[слов] 4
[тексте] 1
[найти] 1
[пары] 2
[наиболее] 2
[связанных] 2
[друг] 2
[с] 2
[другом] 2
[и] 1
[их] 2
[?] 3
[Полезное] 1
[сообщение] 1
[Отправлено] 2
[23] 1
[28] 1
[Вчера] 1
[Iska] 3
[сейчас] 1
[форуме] 1
[Ветеран] 1
[Contributor] 1
[14335] 1
[4358] 1
[Редактировать] 1
[Макросом] 1
[Цитата] 2
[»] 2
[Что] 2
[это] 2
[значит] 2
[09] 1
[57] 1
[Сегодня] 1
[#] 1
[2] 1
[Автор] 1
[темы] 1
[Пары] 1
[которые] 1
[чаще] 1
[всего] 1
[встречаются] 1
[проще] 1
[говоря] 1
|
| Invincible |
10-10-2015 11:18 2562438 |
Цитата:
Цитата Iska
«мама мыла» и «мыла мама» — это должно числиться как одна пара или как две разных пары? »
|
Как одна пара слов |
Invincible, давайте попробуем так:
Скрытый текст
Код:
Option Explicit
Sub Sample()
Dim objWord As Range
Dim strWord As String
Dim objDictionary As Object
Dim elem As Variant
Dim strWord1 As String
Dim strWord2 As String
Dim i As Integer
Set objDictionary = CreateObject("Scripting.Dictionary")
For Each objWord In ThisDocument.Words
strWord = RemoveNonAlpha(objWord.Text)
If Not Len(strWord) = 0 Then
If Not objDictionary.Exists(strWord) Then
objDictionary.Add strWord, 1
Else
objDictionary.Item(strWord) = objDictionary.Item(strWord) + 1
End If
End If
Next
For Each elem In objDictionary.Keys
Debug.Print "[" & elem & "]", objDictionary.Item(elem)
Next
objDictionary.RemoveAll
Debug.Print "===================================================================="
For i = 1 To ThisDocument.Words.Count - 1
strWord1 = LCase(RemoveNonAlpha(ThisDocument.Words.Item(i).Text))
strWord2 = LCase(RemoveNonAlpha(ThisDocument.Words.Item(i + 1).Text))
If Len(strWord1) > 0 And Len(strWord2) > 0 Then
If StrComp(strWord1, strWord2, vbTextCompare) = 1 Then
strWord = strWord2 & " " & strWord1
Else
strWord = strWord1 & " " & strWord2
End If
If Not objDictionary.Exists(strWord) Then
objDictionary.Add strWord, 1
Else
objDictionary.Item(strWord) = objDictionary.Item(strWord) + 1
End If
End If
Next
For Each elem In objDictionary.Keys
Debug.Print "[" & elem & "]", objDictionary.Item(elem)
Next
objDictionary.RemoveAll
Set objDictionary = Nothing
End Sub
Function RemoveNonAlpha(strValue As String) As String
With CreateObject("VBScript.RegExp")
.IgnoreCase = True
.Global = True
.Multiline = True
.Pattern = "([^a-zа-яё])*"
RemoveNonAlpha = .Replace(strValue, "")
End With
End Function
Дополнительно будем удалять из «слов» Word'а все небуквенные символы, а то как-то больно нелепо смотрятся слова из знаков препинания, цифр, кавычек и т.п.
Пример для текста со страницы Темпы распространения Windows 10 за два месяца опережают Windows 7:
Скрытый текст
Код:
[популярной] 1
[из] 1
[когда] 1
[либо] 1
[выпущенных] 1
[операционных] 1
[систем] 1
[для] 2
[персональных] 1
[компьютеров] 1
[Поэтому] 1
[показатели] 1
[распространения] 2
[сравнивают] 1
[именно] 1
[с] 1
[ней] 1
[Статистика] 1
[от] 1
[NetMarketShare] 1
[показывает] 1
[что] 1
[в] 5
[первые] 1
[два] 2
[месяца] 2
[после] 3
[релиза] 1
[дела] 1
[идут] 1
[лучше] 1
[чем] 2
[у] 2
[за] 2
[аналогичный] 1
[промежуток] 1
[времени] 1
[У] 1
[результат] 2
[намного] 1
[ниже] 1
[как] 1
[наглядно] 1
[показано] 1
[графике] 1
[Доля] 2
[достигла] 1
[значения] 1
[против] 1
[привлекла] 1
[своё] 1
[время] 1
[внимание] 1
[только] 1
[Однако] 1
[демонстрировала] 1
[стабильные] 1
[результаты] 1
[течение] 1
[девяти] 1
[месяцев] 1
[чего] 1
[её] 1
[темпы] 1
[выросли] 1
[ещё] 1
[больше] 1
[а] 2
[во] 1
[второй] 1
[месяц] 1
[устанавливали] 1
[примерно] 1
[три] 1
[раза] 1
[меньше] 1
[первый] 1
[через] 1
[лет] 1
[появления] 1
[составляет] 2
[около] 1
[целью] 1
[распространение] 1
[млрд] 1
[устройств] 1
[пока] 1
[же] 1
[млн] 1
====================================================================
[операционная система] 1
[windows система] 1
[исправить призвана] 1
[исправить недостатки] 1
[версии недостатки] 1
[windows версии] 1
[главным однако] 1
[главным стремлением] 1
[microsoft стремлением] 1
[microsoft является] 1
[переманить является] 1
[на переманить] 1
[на неё] 1
[многочисленных неё] 1
[многочисленных пользователей] 1
[windows пользователей] 1
[на последняя] 1
[данный на] 1
[данный момент] 1
[момент уверенно] 1
[лидирует уверенно] 1
[и лидирует] 1
[и может] 1
[может считаться] 1
[самой считаться] 1
[популярной самой] 1
[из популярной] 1
[из когда] 1
[выпущенных либо] 1
[выпущенных операционных] 1
[операционных систем] 1
[для систем] 1
[для персональных] 1
[компьютеров персональных] 1
[показатели поэтому] 1
[показатели распространения] 1
[windows распространения] 1
[именно сравнивают] 1
[именно с] 1
[ней с] 1
[от статистика] 1
[netmarketshare от] 1
[netmarketshare показывает] 1
[в что] 1
[в первые] 1
[два первые] 1
[два месяца] 2
[месяца после] 1
[после релиза] 1
[дела релиза] 1
[windows дела] 1
[идут лучше] 1
[у чем] 1
[windows у] 3
[аналогичный за] 1
[аналогичный промежуток] 1
[времени промежуток] 1
[намного результат] 1
[намного ниже] 1
[как наглядно] 1
[наглядно показано] 1
[на показано] 1
[графике на] 1
[windows доля] 2
[два за] 1
[достигла месяца] 1
[достигла значения] 1
[в привлекла] 1
[в своё] 1
[время своё] 1
[внимание время] 1
[внимание только] 1
[windows однако] 1
[демонстрировала стабильные] 1
[результаты стабильные] 1
[в результаты] 1
[в течение] 1
[девяти течение] 1
[девяти месяцев] 1
[после чего] 1
[её чего] 1
[её темпы] 1
[распространения темпы] 1
[выросли распространения] 1
[выросли ещё] 1
[больше ещё] 1
[windows а] 1
[во второй] 1
[второй месяц] 1
[месяц устанавливали] 1
[примерно устанавливали] 1
[в примерно] 1
[в три] 1
[раза три] 1
[меньше раза] 1
[в чем] 1
[в первый] 1
[лет после] 1
[после появления] 1
[появления составляет] 1
[около составляет] 1
[а для] 1
[windows для] 1
[целью является] 1
[распространение является] 1
[на распространение] 1
[же пока] 1
[же результат] 1
[результат составляет] 1
|
| Invincible |
10-10-2015 16:09 2562495 |
Iska, А как правильно запустить данный макрос?
Вставляю код в редактор Visual Basic, нажимаю Run (F5), но в документе где находится мой текст никаких изменений не происходит, пользуюсь Word 2013.
|
Цитата:
Цитата Invincible
но в документе где находится мой текст никаких изменений не происходит »
|
А разве там должны происходить какие-либо изменения?
Находясь в редакторе VBA, попробуйте нажать «Ctrl-G» для отображения окна «Immediate», куда идёт вывод «Debug.Print».
При желании, конечно, можно сделать вывод в новый документ Word или в текстовый файл на диске. |
| Invincible |
10-10-2015 20:08 2562538 |
Цитата:
Цитата Iska
А разве там должны происходить какие-либо изменения?
Находясь в редакторе VBA, попробуйте нажать «Ctrl-G» для отображения окна «Immediate», куда идёт вывод «Debug.Print». »
|
Все получилось, просто я думал, что результат работы макроса заменит исходный текст.
А нельзя добавить, чтобы учитывались падежи слов? Чтобы слово из-за разного окончания слова относилось к одному слову, а не к 5 например.
И еще союзы, предлоги, частицы удалить из текста, такие как "и", "а". |
Цитата:
Цитата Invincible
А нельзя добавить, чтобы учитывались падежи слов? »
|
Я не припоминаю такого функционала в комплекте Microsoft Office.
Цитата:
Цитата Invincible
И еще союзы, предлоги, частицы удалить из текста, такие как "и", "а". »
|
И такого тоже.
Если «союзы, предлоги, частицы удалить из текста» ещё возможно теоретически (если Вы перечислите все возможные варианты «союзы, предлоги, частицы»), то конкурировать с десятками и сотнями тысяч человеко-лет крупных контор в лексическом анализе нереально. |
Цитата:
Цитата Invincible
И еще союзы, предлоги, частицы удалить из текста, такие как "и", "а". »
|
Возможно подразумевалось не учитывать в подсчётах? Тогда исключить длину слова равную 1 символу в скрипте Iska. Однако это не выход и не решит задачи в целом. А насчёт падежей это по моему не получится, нужна как минимум база-словарь слов, да и то не факт что получится правильно распознать. |
| Invincible |
16-10-2015 00:56 2564359 |
Код:
Option Explicit
Sub Sample()
Dim objWord As Range
Dim strWord As String
Dim objDictionary As Object
Dim elem As Variant
Dim strWord1 As String
Dim strWord2 As String
Dim i As Integer
Set objDictionary = CreateObject("Scripting.Dictionary")
For Each objWord In ThisDocument.Words
strWord = RemoveNonAlpha(objWord.Text)
If Not Len(strWord) = 0 Then
If Not objDictionary.Exists(strWord) Then
objDictionary.Add strWord, 1
Else
objDictionary.Item(strWord) = objDictionary.Item(strWord) + 1
End If
End If
Next
For Each elem In objDictionary.Keys
Debug.Print "[" & elem & "]", objDictionary.Item(elem)
Next
objDictionary.RemoveAll
Debug.Print "===================================================================="
For i = 1 To ThisDocument.Words.Count - 1
strWord1 = LCase(RemoveNonAlpha(ThisDocument.Words.Item(i).Text))
strWord2 = LCase(RemoveNonAlpha(ThisDocument.Words.Item(i + 1).Text))
If Len(strWord1) > 0 And Len(strWord2) > 0 Then
If StrComp(strWord1, strWord2, vbTextCompare) = 1 Then
strWord = strWord2 & " " & strWord1
Else
strWord = strWord1 & " " & strWord2
End If
If Not objDictionary.Exists(strWord) Then
objDictionary.Add strWord, 1
Else
objDictionary.Item(strWord) = objDictionary.Item(strWord) + 1
End If
End If
Next
For Each elem In objDictionary.Keys
Debug.Print "[" & elem & "]", objDictionary.Item(elem)
Next
objDictionary.RemoveAll
Set objDictionary = Nothing
End Sub
Function RemoveNonAlpha(strValue As String) As String
With CreateObject("VBScript.RegExp")
.IgnoreCase = True
.Global = True
.Multiline = True
.Pattern = "([^a-zа-яё])*"
RemoveNonAlpha = .Replace(strValue, "")
End With
End Function
А что нужно изменить в этом макросе, чтобы учитывались три слова, стоящие рядом? |
Время: 21:48.
© OSzone.net 2001-
