Programm für Textanalyse / Wort-Statistik

Dieses Thema Programm für Textanalyse / Wort-Statistik im Forum "Software: Empfehlungen, Gesuche & Problemlösungen" wurde erstellt von Delabarquera, 12. Aug. 2008.

Thema: Programm für Textanalyse / Wort-Statistik Hallo! Ich suche ein Programm, mit dem längere Texte analysiert werden können. Ideal wäre, wenn das Programm...

  1. Hallo!

    Ich suche ein Programm, mit dem längere Texte analysiert werden können. Ideal wäre, wenn das Programm ausgäbe:

    -- Anzahl Wörter
    -- Anzahl Sätze
    -- Buchstaben-Häufigkeit im Text
    -- Wort-Statistik (Liste der Wörter und die Anzahl des Vorkommens des jeweiligen Wortes X im Text)

    Wünsche weiterhin, aber nicht notwendig:

    -- Komplexität der Sätze (Mittelwert Wörter pro Satz, Komplexität nach Anzahl der Kommata in den Sätzen)
    -- Programm kann OpenOffice-Dateien direkt verarbeiten

    Kennt ihr ein solches Programm?

    Grüße! D.
     
  2. MS Word oder auch Open Office haben eine solche Funktion (Extras -> Wörter zählen). Dort können jedoch nur die Anzahld er Wörter gezählt werden. Sätze nicht.
     
  3. Hallo Delabarquera,
    wenn Du darauf verzichtest, dass das Programm Open-Office-Dateien direkt verarbeitest, sondern die Dateien in ein Textfile abspeicherst, könntest Du das Ganze relativ einfach mit einem AWK-Skript erledigen:
    http://gnuwin32.sourceforge.net/packages/gawk.htm
    Viele Grüße - Ulrich
     
  4. Hallo Delabarquera,

    mit einem Makro wäre das für MS-Word ohne weiteres machbar.
    (für Word 2003 und höher)

    Code:
    Option Explicit
    
    Private Type myWorteStatistik_structure
     s_Wort As String
     l_cnt As Long
    End Type
    
    'Einstellungen für die Wortstatistik
    Private Const c_GROSSKLEINSCHREIBUNG_BEACHTEN As Boolean = False
    Private Const c_WORT_MIMIMAL_LAENGE = 2
    Private Const c_BINDESTRICHERSATZ = xxyyzzbbbzzyyxx
    'Einstellungen für die Satz-Komplexitaet - Komma
    Private Const cMAXKOMMAANZAHL = 20-> in einem Satz
    
    
    Sub StatistikWortSatzBuchstabe()
    ->Es wird das aktive Dokument bearbeitet
    ->Der Kontent wird satzweise eingelesen, da dies die größte Einheit ist.
    ->
    ->Statistik über:
    ->- Gesamtanzahl Sätze
     Dim lGesAnz_Satz As Long
    ->- Gesamtanzahl Wörter
     Dim lGesAnz_Wort As Long
    ->- Komplexität Mittelwert Wörter pro Satz
     Dim dMittelwertWoerterProSatz As Double
    ->- Komplexität nach Anzahl der Kommata in den Sätzen
     Dim kk(0 To cMAXKOMMAANZAHL) As Long
    ->- Liste der Wörter und Anzahl deren Vorkommens
     Dim w() As myWorteStatistik_structure, w_cnt As Long
    ->- Buchstaben-Häufigkeit im Text
     Dim b() As Long: ReDim b(33 To 255)
     
     Dim doc As Document, doc_tmp As Document, r As Range
     Dim lStart As Long, lEnd As Long, lEndLast As Long, lAnz As Long
     Dim sTxt As String
     
    ->Application.ScreenUpdating = False
     
     Set doc = ActiveDocument
     Set r = doc.Content
     lStart = r.Start
     lEndLast = r.End
    ->über alle Sätze
     lGesAnz_Satz = r.Sentences.Count
     If lGesAnz_Satz < 2 Then MsgBox Leeres Dokument oder nur ein Satz.: GoTo AUFRAEUMEN
     lGesAnz_Satz = 0
     
    ->tempoäres Dokument anlegen
     Set doc_tmp = Documents.Add
    
     
    ->über alle Sätze
     doc.Content.Select
     Selection.Collapse Direction:=wdCollapseStart
     Selection.Expand Unit:=wdSentence
     lStart = Selection.Start
     lEnd = Selection.Start
     Do
     ->Markierung in einer Tabelle ?
      If Selection.Tables.Count > 0 Then
      ->Endemarke oder Zeile in Tabelle markiert ?
       If Selection.Cells.Count = 0 Then GoTo NAECHSTE
      End If
      
     ->markierten Text holen
      sTxt = Selection.Text
      
     ->ist vor der letzten Endemarke etwas selektiert,
     ->was bereits vorher selektiert/ausgewertet wurde ?
     ->(kommt in der Tabelle vor)
      If Selection.Start < lStart Then
      ->dann vom Text abschneiden
       lAnz = lStart - Selection.Start
       sTxt = Right(sTxt, Len(sTxt) - lAnz)
      End If
      
      Call StringBereinigenVonSteuerzeichen(sTxt)
      If sTxt =  Then GoTo NAECHSTE
      
      lGesAnz_Satz = lGesAnz_Satz + 1
      Call ZeichenStatistik(sTxt, b())
      Call KommasStatistik(sTxt, kk())
      
    NAECHSTE:
     ->war das der letzte Satz ? dann Ende der Untersuchung
      If Selection.End = r.End Then Exit Do
     ->einen Satz weiterschalten
      lStart = Selection.End
      Selection.Collapse Direction:=wdCollapseEnd
      Selection.Expand Unit:=wdSentence
      lEnd = Selection.End
     Loop
     
     Call StatistikWorte(doc, w(), w_cnt, lGesAnz_Wort, doc_tmp)
     
    ->- Komplexität Mittelwert Wörter pro Satz
     dMittelwertWoerterProSatz = lGesAnz_Wort / lGesAnz_Satz
    
     
     doc_tmp.Content.Text = Untersuchte Datei:  & doc.FullName & vbCrLf & vbCrLf
     Call StatistikAusgabe(doc_tmp, lGesAnz_Satz, b(), kk())
     Call Ausgabe_StatistikWorte(w(), w_cnt, lGesAnz_Wort, doc_tmp)
    
    AUFRAEUMEN:
     Application.ScreenUpdating = True
     Set doc_tmp = Nothing: Set doc = Nothing: Set r = Nothing
    End Sub
    
    '*******************************************************************
    Private Function StringBereinigenVonSteuerzeichen(sTxt As String)
    
     Dim sTmp As String, s As String, x As Long
     
     For x = 1 To Len(sTxt)
      s = Mid(sTxt, x, 1)
      If Asc(s) > 31 Then sTmp = sTmp & s
     Next
     sTxt = Trim(sTmp)
    End Function
    '*******************************************************************
    Private Function ZeichenStatistik(sTxt As String, b() As Long)
    
     Dim s As String, x As Long, lAsc As Long
     
     For x = 1 To Len(sTxt)
      s = Mid(sTxt, x, 1)
      lAsc = Asc(s)
      If lAsc > 32 Then b(lAsc) = b(lAsc) + 1
     Next
    End Function
    
    '*******************************************************************
    Private Function StatistikAusgabe(doc As Document, lGesAnz_Satz As Long, b() As Long, kk() As Long)
     Dim t As Table
     Dim x As Long, lAnz As Long, lStart As Long, lEnd As Long
     
     doc.Content.Select
     Selection.Collapse Direction:=wdCollapseEnd
     Selection.InsertAfter vbCrLf & vbCrLf
     Selection.Collapse Direction:=wdCollapseEnd
     
     lStart = Selection.Start
     Selection.InsertAfter Gesamtanzahl Sätze:  & lGesAnz_Satz & vbCrLf & vbCrLf
     lEnd = Selection.End
     Selection.Start = lStart
     Selection.End = lEnd
     Selection.Range.Bold = True
    
     doc.Content.Select
     Selection.Collapse Direction:=wdCollapseEnd
     lStart = Selection.Start
     Selection.InsertAfter Statistik - Kommas pro Satz & vbCrLf & vbCrLf
     lEnd = Selection.End
     Selection.Start = lStart
     Selection.End = lEnd
     Selection.Range.Bold = True
     Selection.Range.Underline = True
     Selection.Collapse Direction:=wdCollapseEnd
     lAnz = 0
     For x = UBound(kk()) To 0
      If kk(x) > 0 Then lAnz = x: Exit For
     Next
     Set t = doc.Tables.Add(Selection.Range, lAnz + 2, 2, wdWord9TableBehavior, wdAutoFitContent)
     t.Cell(1, 1).Range.Text = Anzahl Kommas im Satz
     t.Cell(1, 1).Range.Bold = True
     t.Cell(1, 2).Range.Text = Anzahl Sätze
     t.Cell(1, 2).Range.Bold = True
     For x = 0 To lAnz
      t.Cell(2 + x, 1).Range.Text = x
      t.Cell(2 + x, 2).Range.Text = kk(x)
     Next
    
    
     doc.Content.Select
     Selection.Collapse Direction:=wdCollapseEnd
     Selection.InsertAfter vbCrLf & vbCrLf
     Selection.Collapse Direction:=wdCollapseEnd
     lStart = Selection.Start
     Selection.InsertAfter Buchstaben-Statistik & vbCrLf & vbCrLf
     lEnd = Selection.End
     Selection.Start = lStart
     Selection.End = lEnd
     Selection.Range.Bold = True
     Selection.Range.Underline = True
     Selection.Collapse Direction:=wdCollapseEnd
     For x = LBound(b()) To UBound(b())
      If b(x) > 0 Then lAnz = lAnz + 1
     Next
     Set t = doc.Tables.Add(Selection.Range, lAnz + 1, 2, wdWord9TableBehavior, wdAutoFitContent)
     t.Cell(1, 1).Range.Text = Buchstabe
     t.Cell(1, 1).Range.Bold = True
     t.Cell(1, 2).Range.Text = Anzahl Auftreten
     t.Cell(1, 2).Range.Bold = True
     lAnz = 0
     For x = LBound(b()) To UBound(b())
      If b(x) > 0 Then
       lAnz = lAnz + 1
       t.Cell(1 + lAnz, 1).Range.Text = Chr(x)
       t.Cell(1 + lAnz, 2).Range.Text = b(x)
      End If
     Next
     
    AUFRAEUMEN:
     Set t = Nothing
    End Function
    
    '************************************************************
    Private Function StatistikWorte(doc_org As Document, _
                    f() As myWorteStatistik_structure, f_cnt As Long, _
                    lGesAnz_Wort As Long, doc_tmp As Document)
    '************************************************************
    ' Zählt die Worte des aktiven Dokuments.
    ' Erzeugt ein temporäres Dokument und gibt darauf ein Tabelle
    ' mit den Spalten->Wort' und Häufigkeit aus
    '
    ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ' !!! geschützter Bindestrich und Bindestrich werden vor der Zählung durch
    ' !!! c_BINDESTRICHERSATZ ersetzt, da Word diese sonst als zwei Worte betrachtet.
    ' !!! Nach der Zählung wird diese Ersetzung wieder korrigiert
    ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     Dim myword As Range
     Dim s_Wort As String
     Dim l_Anz As Long, l_ind As Long, x As Long, pos As Long
     
    ->erstmal eine Text-Kopie vom Original anlegen -> keine Tabellen mehr
     doc_tmp.Content.Text = doc_org.Content.Text
     
    ->Statistik initialisieren
     ReDim f(1 To 100): f_cnt = 0
     
    ->im Dokument alle Steuerzeichen durch Leerzeichen ersetzen
     Call SteuerZeichenDurchLeerzeichenErsetzen(doc_tmp.Content)
     
    ->alle Worte abarbeiten
     For Each myword In doc_tmp.Words
      s_Wort = myword.Text
      s_Wort = Trim(s_Wort)
     ->Minimallänge ?
      If Len(s_Wort) < c_WORT_MIMIMAL_LAENGE Then GoTo NAECHSTESWORT
      
     ->GroßKleinschreibung beachten ?
      If Not c_GROSSKLEINSCHREIBUNG_BEACHTEN Then s_Wort = LCase(s_Wort)
     ->Wort suchen
      l_ind = 0
      For x = 1 To f_cnt
       If s_Wort = f(x).s_Wort Then l_ind = x: Exit For
      Next
     ->Wort schon vorhanden
      If l_ind > 0 Then
      ->schon vorhanden -> Zähler erhöhen
       f(l_ind).l_cnt = f(l_ind).l_cnt + 1
      Else
      ->nicht vorhanden -> neu anlegen
       f_cnt = f_cnt + 1
       If UBound(f()) < f_cnt Then ReDim Preserve f(1 To f_cnt + 100)
       f(f_cnt).l_cnt = 1: f(f_cnt).s_Wort = s_Wort
      End If
     
    NAECHSTESWORT:
     Next
     lGesAnz_Wort = 0
     For x = 1 To f_cnt
      s_Wort = f(x).s_Wort
      Do
       pos = InStr(1, s_Wort, c_BINDESTRICHERSATZ)
       If pos = 0 Then Exit Do
      ->BINDESTRICHERSATZ durchBindestrich ersetzen
       s_Wort = Left(s_Wort, pos - 1) & Chr(30) & _
           Right(s_Wort, Len(s_Wort) - pos + 1 - Len(c_BINDESTRICHERSATZ))
      Loop
      f(x).s_Wort = s_Wort
      lGesAnz_Wort = lGesAnz_Wort + f(x).l_cnt
     Next
      
    AUFRAEUMEN:
     Set myword = Nothing
    End Function
    
    '************************************************************
    Private Function Ausgabe_StatistikWorte(f() As myWorteStatistik_structure, f_cnt As Long, _
                        lGesAnz_Wort As Long, doc_tmp As Document)
    '************************************************************
    ' Gibt am Ende des Dokumentes ein Tabelle mit den Spalten->Wort' und Häufigkeit aus
     
     Dim mytab As Table
     Dim s_Wort As String
     Dim l_Anz As Long, lStart As Long, lEnd As Long, x As Long
     
     doc_tmp.Content.Select
     Selection.Collapse Direction:=wdCollapseEnd
     Selection.InsertAfter vbCrLf & vbCrLf
     Selection.Collapse Direction:=wdCollapseEnd
     
     lStart = Selection.Start
     Selection.InsertAfter Gesamtanzahl Worte:  & lGesAnz_Wort & vbCrLf & vbCrLf
     lEnd = Selection.End
     Selection.Start = lStart
     Selection.End = lEnd
     Selection.Range.Bold = True
    
     Selection.Collapse Direction:=wdCollapseEnd
     lStart = Selection.Start
     Selection.InsertAfter Wort-Statistik & vbCrLf & vbCrLf
     lEnd = Selection.End
     Selection.Start = lStart
     Selection.End = lEnd
     Selection.Range.Bold = True
     Selection.Range.Underline = True
     Selection.Collapse Direction:=wdCollapseEnd
     
    ->Tabelle einfügen
     Set mytab = doc_tmp.Tables.Add(Selection.Range, f_cnt + 1, 2, wdWord9TableBehavior, wdAutoFitContent)
     With mytab.Cell(1, 1).Range: .Text = Wort: .Bold = True: End With
     With mytab.Cell(1, 2).Range: .Text = Anzahl: .Bold = True: End With
     For x = 1 To f_cnt
      s_Wort = f(x).s_Wort
      mytab.Cell(x + 1, 1).Range.Text = s_Wort
      mytab.Cell(x + 1, 2).Range.Text = f(x).l_cnt
     Next
    ->Tabelle sortieren
     mytab.Sort _
      ExcludeHeader:=True, _
      FieldNumber:=1, _
      SortFieldType:=wdSortFieldAlphanumeric, _
      SortOrder:=wdSortOrderAscending, _
      CaseSensitive:=c_GROSSKLEINSCHREIBUNG_BEACHTEN
      
    AUFRAEUMEN:
     Set mytab = Nothing
     
    End Function
    Private Function SteuerZeichenDurchLeerzeichenErsetzen(r As Range)
     
     Dim x As Long
     
     Call myErsetzen(r, Chr(30), c_BINDESTRICHERSATZ) ->geschützter Bindestrich -> c_BINDESTRICHERSATZ
     Call myErsetzen(r, Chr(45), c_BINDESTRICHERSATZ) ->Bindestrich       -> c_BINDESTRICHERSATZ
     
    ->Steuerzeichen durch Leerzeichen ersetzen
     For x = 1 To 30
     Call myErsetzen(r, Chr(x),  ) ->Steuerzeichen (1 -30)  -> Leerzeichen
     Next
     
     Call myErsetzen(r, Chr(31), ) ->bedingter Trennstrich  -> löschen
     Call myErsetzen(r, Chr(151), ) ->Langer Gedankenstrich  -> löschen
     Call myErsetzen(r, Chr(150), ) ->Gedankenstrich      -> löschen
     Call myErsetzen(r, Chr(160),  )->geschütztes Leerzeichen -> Leerzeichen
     Call myErsetzen(r, Chr(182),  )->Absatz          -> Leerzeichen
     Call myErsetzen(r, Chr(133),  )->Auslasspunkte      -> Leerzeichen
     Call myErsetzen(r, Chr(145),  )->einf. öffnendes  Anfz. -> Leerzeichen
     Call myErsetzen(r, Chr(146),  )->einf. schliessendes Anfz. -> Leerzeichen
     Call myErsetzen(r, Chr(147),  )->   öffnendes  Anfz. -> Leerzeichen
     Call myErsetzen(r, Chr(148),  )->   schliessendes Anfz. -> Leerzeichen
     
     For x = 10 To 2 Step -1
     Call myErsetzen(r, String(x,  ),  )->doppelte Leerzeichen -> Leerzeichen
     Next
    End Function
    Private Function myErsetzen(r As Range, s_Text As String, s_Ersetzen As String)
     Selection.Find.ClearFormatting
     Selection.Find.Replacement.ClearFormatting
     With r.Find
      .Text = s_Text: .Replacement.Text = s_Ersetzen: .Wrap = wdFindContinue: .Format = False
     End With
     r.Find.Execute Replace:=wdReplaceAll
    End Function
    Private Function KommasStatistik(sTxtSatz As String, kk() As Long)
     Dim lAnz As Long, pos As Long
     lAnz = 0
     pos = 0
     Do
      pos = InStr(pos + 1, sTxtSatz, ,)
      If pos > 0 Then lAnz = lAnz + 1 Else Exit Do
     Loop
     
     If lAnz > cMAXKOMMAANZAHL Then lAnz = cMAXKOMMAANZAHL
     kk(lAnz) = kk(lAnz) + 1
    
    End Function
    Gruß Matjes :)[br][br]Erstellt am: Mo, 18.08.08, 17:30:08[hr][br] ;)
     
  5. Hallo, Matjes! Das ist ein prima Tipp. Nur ist es so, dass ich ein notorischer OpenOffice-Benutzer bin. (Nichts gegen Word. Ist eher eine uralte Gewohnheit. Vielleicht probier ich es auf dem Rechner meiner Frau mal aus. Falls es nichts entsprechende für OO gibt.) - Grüße! D.
     
  6. Hallo,

    also, ich werde mal Funde zusammentragen. Das Problem ist ja oft, dass Texte in non-txt vorliegen. Dieses Tool verspricht die Umwanldung. Ältere Erfahrungen sagen auch: Die deutschen Sonderzeichen ß, ä, usw. machen Probleme. Es kommt also erst mal darauf an, einen Normaltext vorlegen zu können bzw. ein Programm zu haben, dass die Sonderzeichen akzeptiert. Das folgende Programm verspricht immerhin eine Vorstufe:

    http://text-mining-tool.com/


    Grüße! D.

    ------------------------------

    ------------------------------

    Viele Programme versprechen allerdings dem Management die kostengünstige Durchsicht großer Textmengen. (Mein Ziel ist das -- das Geschäftliche -- nicht.)

    http://www.computerwoche.de/knowled...1868692/index.html#EL_12161068930169193001287

    ------------------------------

    Und diese -- englische -- Zusammenfassung gibt einen Überblick:

    http://staff.science.uva.nl/~jvgemert/pub/textminingtools.pdf


    ------------------------------

    Leider ist die Übersicht aus dem Jahr 2000.
     
Die Seite wird geladen...

Programm für Textanalyse / Wort-Statistik - Ähnliche Themen

Forum Datum
Welches Programm für mkv unter Windows? Audio, Video und Brennen 23. Aug. 2016
Suche Programm für Uni zum mitschreiben Software: Empfehlungen, Gesuche & Problemlösungen 9. Juni 2015
Altes Programm für WIN 7-64Bit Software: Empfehlungen, Gesuche & Problemlösungen 17. Jan. 2015
MacOS: Programm für Fensterverwaltung - Halbieren,vierteln [gesucht] Linux & Andere 19. Sep. 2014
Ich möchte ein DOS Programm nutzen für Programmierung von Funkgeräten - welches Win? Windows 95-2000 18. Dez. 2013