Fehleranalyse beim Vergleich zweier Worte

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Thorsten1867
Beiträge: 1360
Registriert: 04.02.2005 15:40
Computerausstattung: [Windows 10 x64] [PB V5.7x]
Wohnort: Kaufbeuren
Kontaktdaten:

Fehleranalyse beim Vergleich zweier Worte

Beitrag von Thorsten1867 »

Vielleicht kann's jemand brauchen (z.B. für Vokabeltrainer oder Lernprogramme):

Code: Alles auswählen

Wort$ = "Apfelbaum"
Eingabe$ = "Ahpflpaumen"

Procedure.s FehlerAnalyse(ori$, check$)
  Define.w os = 1, ol = 1, cs = 1, cl = 1
  
  LenO.b = Len(ori$) : LenC.b = Len(check$)
  If LenC > LenO ;{ max. Buchstabenzahl
    LenWort.b = LenC
  Else 
    LenWort.b = LenO
  EndIf ;}
  
  For i=1 To LenWort
    If Len(Mid(ori$, os, ol)) < Len(Mid(check$, cs, cl)) ;{ zuviele Buchstaben (Wortende)
      Debug "------------------"
      Debug "zuviele Buchstaben ("+Str(cs+cl-1)+"-"+Str(LenC)+"): '" + Mid(check$, cs+cl-1, LenC-cs-cl+2)+"'"
      fehler$ + "zuviele Buchstaben ("+Str(cs+cl-1)+"-"+Str(LenC)+"): "+Mid(check$, cs+cl-1, LenC-cs-cl+2)
      Break
      ;}
    ElseIf Len(Mid(ori$, os, ol)) > Len(Mid(check$, cs, cl)) ;{ zu wenig Buchstaben (Wortende)
      Debug "------------------"
      Debug "zu wenig Buchstaben: '" + Mid(ori$, os+ol-1, LenO-os-ol+2)+"'"
      fehler$ + "zu wenig Buchstaben : "+Mid(ori$, os+ol-1, LenO-os-ol+2)
      Break
      ;}
    ElseIf Mid(ori$, os, ol) = Mid(check$, cs, cl) ;{ Übereinstimmung
      ol + 1 : cl + 1
      ;}
    Else ;{ Fehler
      Debug "------------------"
      Debug "Fehler: '"+Mid(ori$, os, ol)+"' <> '"+Mid(check$, cs, cl)+"'"
      Debug "------------------"
      If Mid(ori$, os, ol) = Mid(check$, cs, cl-1) + Mid(check$, cs+cl, 1) ;{ Buchstabe zuviel
        Debug "zuviel ("+Str(cs+cl-1)+"): '"+ Mid(ori$, os, ol)+"' = '"+Mid(check$, cs, cl-1)+"||"+Mid(check$, cs+cl, 1)+"'"
        fehler$ + "Buchstabe zuviel ("+Str(cs+cl-1)+"): " + Mid(check$,cs+cl-1,1) +"   "+ Chr(10)
        os + ol - 1 : cs + cl : ol = 1 : cl = 1
        ;} ----------
      ElseIf Mid(ori$, os, ol+1) = Mid(check$, cs, cl-1) + Mid(ori$, os+ol-1, 1) + Mid(check$, cs+cl-1, 1) ;{ Buchstabe zuwenig
        Debug "fehlt ("+Str(cs+cl-2)+"-"+Str(cs+cl-1)+"): '"+ Mid(ori$, os, ol+1) +"' = '"+Mid(check$, cs, cl-1) +"|"+ Mid(ori$, os+ol-1, 1) +"|"+ Mid(check$, cs+cl-1, 1)
        fehler$ + "Buchstabe fehlt ("+Str(cs+cl-2)+"-"+Str(cs+cl-1)+"): " + Mid(ori$, os+ol-1, 1) +"   "+ Chr(10)
        os + ol : cs + cl - 1 : ol = 1 : cl = 1
        ;}
      Else ;{ falscher Buchstabe
        Debug "falsch ("+Str(cs+cl-1)+"): '"+ Mid(check$, cs+cl-1, 1)+"'"
        fehler$ + "falscher Buchstabe ("+Str(cs+cl-1)+"): " + Mid(check$, cs+cl-1, 1) +"   "+ Chr(10)
        os + ol : cs + cl : ol = 1 : cl = 1
        ;} ----------
      EndIf
      ;}
    EndIf
  Next

  ProcedureReturn fehler$
EndProcedure

If Wort$ = Trim(Eingabe$)
  Debug "--- Richtig ---"
Else
  Debug Wort$+" <> "+Eingabe$
  result$ = FehlerAnalyse(Wort$, Eingabe$)
  Debug "----------"
  If result$
    MessageRequester(" Fehleranalyse", result$, #MB_OK|#MB_ICONWARNING)
  EndIf
EndIf
Download of PureBasic - Module
Download of PureBasic - Programmes

[Windows 11 x64] [PB V6]

Bild