PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Rechtschreibkontrolle mit eigenen Wortlisten

https://www.purebasic.fr/german/viewtopic.php?t=24577

Seite 1 von 1

Rechtschreibkontrolle mit eigenen Wortlisten

Verfasst: 16.07.2011 20:21
von Thorsten1867
Aus einer Wörterliste eine Dictionary-Datei generieren.

Code: Alles auswählen

;/ Rechtschreibkontrolle 
;/ *** Dictionary aus Wörterliste erzeugnen ***
;/ by Thorsten Hoeppner (Juli 2011)

; Format: wortstamm # endung1 | endung2 | ... # Großschreibung
; (Wortstamm muss mind. 4 Buchstaben haben, falls Endungen angegeben sind)
; Beispiel: kontrolliert#e|em|en|er|es#0
; Beispiel: kontrolle#n#1
; Beispiel: kontrollieren##0

#Source = 0
#Target = 1

Procedure.s GetProgramDirectory() ; Program Path
  Protected ProgDir.s, TempDir.s
  TempDir = GetTemporaryDirectory() 
  ProgDir = GetPathPart(ProgramFilename())
  If ProgDir = #PB_Compiler_Home+"Compilers\" Or UCase(ProgDir) = UCase(TempDir)
    ProgDir = GetCurrentDirectory()
  EndIf
  ProcedureReturn ProgDir
EndProcedure

ProgDir$ = GetProgramDirectory()

Structure WortStructure
  Stamm.s
  Endung.s
  Art.s
EndStructure
NewList worte.WortStructure()

If ReadFile(#Source, ProgDir$+"Woerterliste.txt")
  While Eof(#Source) = 0
    wort$ = Trim(ReadString(#Source))
    AddElement(worte())
    worte()\Stamm = LCase(StringField(wort$,1,"#"))
    worte()\Endung = StringField(wort$,2,"#")
    worte()\Art = StringField(wort$,3,"#")
  Wend
  
  CloseFile(#Source)
  
  SortStructuredList(worte(), #PB_Sort_Ascending, OffsetOf(WortStructure\Stamm), #PB_Sort_String)
  
  If CreateFile(#Target, ProgDir$+"deutsch.dic")
    WriteByte(#Target, 0)
    ForEach worte()
      WriteString(#Target, worte()\Stamm + "#" + worte()\Endung + "#" + worte()\Art)
      WriteByte(#Target, 0)
    Next
    CloseFile(#Target)
  EndIf
  
EndIf
Unbekannte Wörter (mögl. Rechtschreibfehler) in dem Text finden:

Code: Alles auswählen

;/ Rechtschreibkontrolle
;/ basiert auf einem Algorithmus von "netmaestro" (lexicon_pb.dll)
;/ by Thorsten Hoeppner (Juli 2011)

#File = 0
#RegExpr = 0

Procedure.s GetProgramDirectory() ; Program Path
  Protected ProgDir.s, TempDir.s
  TempDir = GetTemporaryDirectory() 
  ProgDir = GetPathPart(ProgramFilename())
  If ProgDir = #PB_Compiler_Home+"Compilers\" Or UCase(ProgDir) = UCase(TempDir)
    ProgDir = GetCurrentDirectory()
  EndIf
  ProcedureReturn ProgDir
EndProcedure

Procedure.s ReplaceRegExpr(text.s, replacetext.s, RegExpr.s)
  If CreateRegularExpression(#RegExpr, RegExpr)
    result$ = ReplaceRegularExpression(#RegExpr, text, replacetext)
    FreeRegularExpression(#RegExpr)
  EndIf
  ProcedureReturn result$
EndProcedure

Procedure LoadDic(File.s) ; Wörterliste einlesen (Speicher)
  Global *StartDicMem, *EndDicMem
  If ReadFile(#File, File)
    FileLen = Lof(#File)
    *StartDicMem = AllocateMemory(FileLen)
    If *StartDicMem
      DicLen = ReadData(#File, *StartDicMem, FileLen)
      *EndDicMem = *StartDicMem + DicLen
    EndIf
    CloseFile(0)
    ProcedureReturn DicLen
  EndIf
EndProcedure

Procedure FreeDic() ; Speicher freigeben
  If *StartDicMem
    FreeMemory(*StartDicMem)
  EndIf
EndProcedure


Procedure.l WordExists(word$)
  Define.b SetLoMem = #False
  
  search$ = LCase(word$)
  *loMem = *StartDicMem
  *hiMem = *EndDicMem
  
  While (*hiMem-*loMem) > 0
    
    ;{ Mitte des aktuellen Speicherbereichs ermitteln & Wortanfang suchen (Byte: 0)
    If SetLoMem
      *Mem = *loMem + 1
      *loMem = *Mem + MemoryStringLength(*Mem)
      SetLoMem = #False
    Else
      *Mem = *loMem + (*hiMem-*loMem) >> 1
      While PeekB(*Mem-1) <> #Null
        *Mem-1
      Wend
    EndIf ;}
    
    check$ = StringField(PeekS(*Mem), 1, "#")
    
    If search$ = check$ ;{ direkter Treffer
      If StringField(PeekS(*Mem), 3, "#") = "1" ; Großschreibung nötig
        If Left(UCase(check$),1) = Left(word$,1)
          ProcedureReturn #True
        EndIf
      Else
        ProcedureReturn #True
      EndIf
      ;}
    ElseIf Left(search$, Len(check$)) = check$ ;{ Wortstamm + Endungen
      ending$ = StringField(PeekS(*Mem), 2, "#")
      If ending$
        For e=1 To CountString(ending$, "|")+1
          If search$ = check$+StringField(ending$, e, "|")
            If StringField(PeekS(*Mem), 3, "#") = "1" ; Großschreibung nötig
              If Left(UCase(check$),1) = Left(word$,1)
                ProcedureReturn #True
              EndIf
            Else
              ProcedureReturn #True
            EndIf
          EndIf
        Next
      EndIf
      ;}
    EndIf
   
    ;{ kein Treffer
    If Left(search$, 4) = Left(check$, 4) ; mind. Wortstamm gleich
      Debug "-> "+search$+" = "+check$
      SetLoMem = #True
    ElseIf search$ < check$
      *hiMem = *Mem - 1 ; Wort und Speicherbereich darüber abschneiden
    Else
      *loMem = *Mem + MemoryStringLength(*Mem) ; Wort und Speicherbereich darunter abschneiden
    EndIf
    ;}
    
  Wend
  
  ProcedureReturn #False
EndProcedure
Procedure SpellCheck(Text$, Name$, List unknown.s()) ; Rechtschreibung überprüfen
  Protected result$, wort$
  
  ; Text$: Text zum Überprüfen
  ; Name$: Eigenname der ignoriert werden soll
  ; unknown.s(): LinkedList für unbekannte Worte 
  
  Text$ = ReplaceString(Text$, "- und", Chr(172)+" und") ; Bindestriche ersetzen
  Text$ = ReplaceString(Text$, "- oder", Chr(172)+" oder") ; Bindestriche ersetzen
  Text$ = ReplaceString(Text$, "- bzw", Chr(172)+"= bzw") ; Bindestriche ersetzen
  Text$ = ReplaceString(Text$, "- ", Chr(166)) ; Trennungen ersetzen 
  Text$ = ReplaceString(Text$, Chr(172), "-") ; Bindestriche zurücksetzen
  Text$ = Trim(ReplaceRegExpr(Text$+" ", " ", "[\(\)'/,;!:&\x22\r\n\xB6\x22]|(\. )|(·/·)"))
  
  For w = 1 To CountString(Text$, " ")+1
    
    wort$ = RTrim(StringField(Text$, w, " "), ".") ; wortweise auslesen
    If wort$ = StringField(Name$, 1, " ") Or wort$ = StringField(Name$, 1, " ")+"s" Or wort$ = "" ; Eigenname ignorieren
      Continue
    EndIf
    
    ; Wort (ohne Trennung) überprüfen
    If WordExists(RemoveString(wort$, Chr(166))) = #False 
      AddElement(unknown())
      unknown() = ReplaceString(wort$, Chr(166), "- ")
    EndIf
    
  Next
  
  If ListSize(unknown())
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure


;- Testen der Rechtschreibkontrolle

NewList ErrorRS.s() 

If LoadDic(GetProgramDirectory()+"deutsch.dic")

  Text$ = "Fred verwendete seine volle aufmerksamkeit nicht immer auf das Unterrichtsge- schehen. Er ließ sich leicht ablenken und konte sich teilweise nur kurze Zeit auf eine Sa- che konsentrieren."
  Name$ = "Fred"
  
  If SpellCheck(Text$, Name$, ErrorRS())
    Debug "=== Unbekannte Worte ==="
    ForEach ErrorRS()
      Debug "-> "+ErrorRS()
    Next
  EndIf
  
  FreeDic()
EndIf
Das Dictionary-Format unterstützt mehrere zusätzliche Endungen und wird auch die korrekte Großschreibung von Nomen geprüft.
Die fehlerhaften bzw. unbekannten Wörter werden in Form einer LinkedList zurückgeliefert.

Meine (schulbezogene) Wörterliste: Woerterliste.txt (130KB)

[EDIT]Problem behoben, dass einzelne Wörter nicht gefunden wurden[/EDIT]

Re: Rechtschreibkontrolle mit eigenen Wortlisten

Verfasst: 16.07.2011 20:36
von ts-soft
Wie wäre es, wenn Du uns

Code: Alles auswählen

GetProgramDirectory()
mit lieferst :wink:

Procedure.b finde ich immer unschön, hat wenn überhaupt nur negative Einfluesse auf das Programm.
Wenn nichts anderes unbedingt erforderlich ist, wäre Procedure.i die bessere wahl.

Gruß
Thomas

Re: Rechtschreibkontrolle mit eigenen Wortlisten

Verfasst: 16.07.2011 20:40
von Thorsten1867
Ups, habe vergessen, dass es kein orginaler PB-Befehl ist.

Code: Alles auswählen

Procedure.s GetProgramDirectory() ; Program Path
  Protected ProgDir.s, TempDir.s
  TempDir = GetTemporaryDirectory() 
  ProgDir = GetPathPart(ProgramFilename())
  If ProgDir = #PB_Compiler_Home+"Compilers\" Or UCase(ProgDir) = UCase(TempDir)
    ProgDir = GetCurrentDirectory()
  EndIf
  ProcedureReturn ProgDir
EndProcedure

Re: Rechtschreibkontrolle mit eigenen Wortlisten

Verfasst: 16.07.2011 20:41
von RSBasic
Hier noch zwei weitere Wörterlisten:
http://www.rsbasic.de/temp/words.german.zip (2,11 MB (entpackt))
http://www.rsbasic.de/temp/Wortliste_by_AND51.zip (2,75 MB (entpackt))

Re: Rechtschreibkontrolle mit eigenen Wortlisten

Verfasst: 16.07.2011 20:49
von Thorsten1867
RSBasic hat geschrieben:Hier noch zwei weitere Wörterlisten:
http://www.rsbasic.de/temp/words.german.txt (2,11 MB)
http://www.rsbasic.de/temp/Wortliste_by_AND51.txt (2,75 MB)
Müsste man noch etwas anpassen an mein etwas kompakteres Format (Wortstamm+Endungen / Großschreibung erforderlich) oder den Code entsprechend abändern.

Meine Format: (20.379 Wörter => 131 KByte )
  • kontrolliert#e|em|en|er|es#0
    kontrolle#n#1
    kontrollieren##0
Standardformat:
  • kontrolliert
    kontrollierte
    kontrolliertem
    kontrollierten
    kontrollierter
    kontrolliertes
    Kontrolle
    Kontrollen
    kontrollieren
    Kontrollieren

Re: Rechtschreibkontrolle mit eigenen Wortlisten

Verfasst: 16.07.2011 20:57
von AND51
@ RSBasic
Danke fürs Verlinken! Hätte das sonst jetzt selbst gemacht. :allright:

Re: Rechtschreibkontrolle mit eigenen Wortlisten

Verfasst: 17.07.2011 15:45
von Thorsten1867
Einige Optimierungen. Die aufwendigeren Vergleichsroutinen werden erst ausgeführt, wenn die ersten 4 Buchstaben (= Minimallänge Wortstamm bei Endungen) übereinstimmen.

Code: Alles auswählen

Procedure.l WordExists(word$)
  Define.b SetLoMem = #False
  
  *loMem = *StartDicMem
  *hiMem = *EndDicMem
  LWord$ = LCase(word$)
  
  While (*hiMem-*loMem) > 0
    
    ;{ Mitte des aktuellen Speicherbereichs ermitteln & Wortanfang suchen (Byte: 0)
    If SetLoMem
      *Mem = *loMem + 1
      *loMem = *Mem + MemoryStringLength(*Mem)
      SetLoMem = #False
    Else
      *Mem = *loMem + (*hiMem-*loMem) >> 1
      While PeekB(*Mem-1) <> #Null
        *Mem-1
      Wend
    EndIf ;}
    
    check$ = StringField(PeekS(*Mem), 1, "#")
    Select CompareMemoryString(@check$, @word$, #PB_String_NoCase, 4)
      Case #PB_String_Equal ; Übereinstimmung prüfen
        If check$ = LWord$ ;{ direkter Treffer
          If StringField(PeekS(*Mem), 3, "#") = "1" ; nur Großschreibeung
            If UCase(Left(check$,1)) = Left(word$,1) ; ersten Buchstaben überprüfen
              ProcedureReturn #True
            EndIf
          Else ; Groß- und Kleinschreibung
            ProcedureReturn #True
          EndIf ;}
        ElseIf Left(LWord$, Len(check$)) = check$ ;{ Wortstamm + Endungen
          ending$ = StringField(PeekS(*Mem), 2, "#")
          If ending$
            For i=1 To CountString(ending$, "|")+1
              If check$+StringField(ending$, i, "|") = LWord$ ;{ Treffer
                If StringField(PeekS(*Mem), 3, "#") = "1" ; nur Großschreibeung
                  If UCase(Left(check$,1)) = Left(word$,1) ; ersten Buchstaben überprüfen
                    ProcedureReturn #True
                  EndIf
                Else ; Groß- und Kleinschreibung
                  ProcedureReturn #True
                EndIf
              EndIf ;}
            Next
          EndIf ;}
        EndIf
        SetLoMem = #True
      Case #PB_String_Lower
        *loMem = *Mem + MemoryStringLength(*Mem) ; Wort und Speicherbereich darunter abschneiden
      Case #PB_String_Greater
        *hiMem = *Mem - 1 ; Wort und Speicherbereich darüber abschneiden
    EndSelect
    
  Wend
  
  ProcedureReturn #False
EndProcedure

Re: Rechtschreibkontrolle mit eigenen Wortlisten

Verfasst: 17.07.2011 16:07
von Thorsten1867
Die Wortlisten von RSBasic und AND51 sollten mit dieser Version funktionieren:

Code: Alles auswählen

;- Algorithmus für einfache Wortlisten ohne Endungen usw.

Procedure.l WordExists(word$)
  Define.b SetLoMem = #False
  
  *loMem = *StartDicMem
  *hiMem = *EndDicMem
  
  While (*hiMem-*loMem) > 0
    
    ;{ Mitte des aktuellen Speicherbereichs ermitteln & Wortanfang suchen (Byte: 0)
    *Mem = *loMem + (*hiMem-*loMem) >> 1
    While PeekB(*Mem-1) <> #Null
      *Mem-1
    Wend ;}
    
    If word$ = PeekS(*Mem) ; Treffer
      ProcedureReturn #True
    ElseIf word$ < PeekS(*Mem)
      *hiMem = *Mem - 1 ; Wort und Speicherbereich darüber abschneiden
    Else
      *loMem = *Mem + MemoryStringLength(*Mem) ; Wort und Speicherbereich darunter abschneiden
    EndIf
    
  Wend
  
  ProcedureReturn #False
EndProcedure

Re: Rechtschreibkontrolle mit eigenen Wortlisten

Verfasst: 17.07.2011 19:01
von X360 Andy
Mit Office 2010 kann man die Word Rechtschreibhilfe per COM Schnittstelle verwenden.

Wrapper müsste ich raussuchen ;)

Re: Rechtschreibkontrolle mit eigenen Wortlisten

Verfasst: 19.07.2011 22:16
von neotoma
Hallo,

schöne Sache!

Ich habe selber den Spell-Checker von OpenOffice verpfilchtet: http://www.purebasic.fr/german/viewtopi ... =8&t=23136.

Mike
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de