PureBoard

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

Umlaute ersetzen, geht das schneller ?

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

Seite 1 von 3

Umlaute ersetzen, geht das schneller ?

Verfasst: 21.03.2019 00:10
von hjbremer
Da Purebasics ReplaceString eine eierlegende Wollmilchsau ist hier mal meine Version für einen speziellen Fall.

nur geht es noch schneller ? und ja ich weiß, If ElseIf ist ev. schneller als Select case, aber es sieht chaotischer aus und bringt nicht viel.

Code: Alles auswählen

;Debugger aus !!!

Procedure.s ReplaceUmlaute(*text.Character)
   
   ;Ä ä Ö ö Ü ü ß "
   ;AeaeOeoeUeuess"
   
   Protected newlg = MemoryStringLength(*text, #PB_ByteLength) * 2
   
   Protected new$, *buff.Character = AllocateMemory(newlg) , mem = *buff
   
   While *text\c        ;1.Zeichen im Text bei Start
      
      Select *text\c
         Case 'Ä' : *buff\c = 'A' :  *buff + SizeOf(Character) : *buff\c = 'e'
         Case 'Ö' : *buff\c = 'O' :  *buff + SizeOf(Character) : *buff\c = 'e' 
         Case 'Ü' : *buff\c = 'U' :  *buff + SizeOf(Character) : *buff\c = 'e'
         Case 'ä' : *buff\c = 'a' :  *buff + SizeOf(Character) : *buff\c = 'e'
         Case 'ö' : *buff\c = 'o' :  *buff + SizeOf(Character) : *buff\c = 'e' 
         Case 'ü' : *buff\c = 'u' :  *buff + SizeOf(Character) : *buff\c = 'e' 
         Case 'ß' : *buff\c = 's' :  *buff + SizeOf(Character) : *buff\c = 's'              
         Default  : *buff\c = *text\c               
      EndSelect     
      *text + SizeOf(Character) ;zum nächsten Zeichen im Text
      *buff + SizeOf(Character) ;zum nächsten Zeichen im Textbuffer
      
   Wend
   
   new$ = PeekS(mem): FreeMemory(mem)

   ProcedureReturn new$
EndProcedure

max = 100000
text$ = "Über Äpfel Rüben Straße ärgert Ösil + Bär" 

s = ElapsedMilliseconds()
For j = 1 To max
   xx$ = text$:    
   xx$ = ReplaceString(xx$, "Ä", "Ae")
   xx$ = ReplaceString(xx$, "Ü", "Ue")
   xx$ = ReplaceString(xx$, "Ö", "Oe") 
   xx$ = ReplaceString(xx$, "ä", "ae") 
   xx$ = ReplaceString(xx$, "ü", "ue") 
   xx$ = ReplaceString(xx$, "ö", "oe") 
   xx$ = ReplaceString(xx$, "ß", "ss") 
   
Next
ss = ElapsedMilliseconds() - s

s = ElapsedMilliseconds()
For j = 1 To max 
   new$ = ReplaceUmlaute(@text$)
Next
su = ElapsedMilliseconds() - s

info$ + #LF$
info$ + xx$  + " -PB:" + #TAB$ + Str(ss) + #LF$

info$ + new$ + " -ich" + #TAB$ + Str(su) + #LF$


MessageRequester("", info$)

Re: Umlaute ersetzen, geht das schneller ?

Verfasst: 21.03.2019 00:52
von mk-soft
Ich glaube das du es schon optimal gelöst hast. Schneller geht es nur noch in ASM.
Da ist aber der Aufwand zu gross.

Re: Umlaute ersetzen, geht das schneller ?

Verfasst: 21.03.2019 08:49
von STARGÅTE
Es ist schon sehr umständlich, wenn du bei jedem Character jedes mal 7 Abfragen machst, denn üblicherweise sind die meisten Zeichen ja keine der 7 Umlaute.

Man könnte hier (auch ohne ASM) ggf. mit einer Ersetzungstabelle (Ersetzungs-Array) arbeiten:

Code: Alles auswählen

Replace('A') = 'A'
Replace('B') = 'B'
...
Replace('Ä') = 'eA' ; Das wird als String zu "Ae"
Dann kannst du ohne Abfragen einfach einen neuen String schreiben:

Code: Alles auswählen

*buffer\l = Replace(*text\c)
Ja ich nutze hier absichtlich *buffer\l damit beide "neuen" Buchstaben geschrieben werden. Da du ja eh den koppelten Speicher erstellt sollte das passen.
Der Sprung zum nächsten Zeichen wäre dann entweder 1 oder 2 characters (was du ja auch ohne Abfrage über das Replace() array errechnen kannst).

Re: Umlaute ersetzen, geht das schneller ?

Verfasst: 21.03.2019 11:49
von juergenkulow
Hallo hjbremer,

und dann wurde 2008 das ß groß und machte das schöne Programm leider unvollständig.
Spiegel online Das ß wird groß
Der Unicode lautet U+1E93 und hat damit 2 Byte.

Gruß

Re: Umlaute ersetzen, geht das schneller ?

Verfasst: 21.03.2019 13:00
von Josh
Du könntest dein Select noch in eine If-Abfrage stecken:

Code: Alles auswählen

      If *Text\c >= 'Ä'
        Select *text\c
           Case 'Ä' : *buff\c = 'A' :  *buff + SizeOf(Character) : *buff\c = 'e'
           Case 'Ö' : *buff\c = 'O' :  *buff + SizeOf(Character) : *buff\c = 'e' 
           Case 'Ü' : *buff\c = 'U' :  *buff + SizeOf(Character) : *buff\c = 'e'
           Case 'ä' : *buff\c = 'a' :  *buff + SizeOf(Character) : *buff\c = 'e'
           Case 'ö' : *buff\c = 'o' :  *buff + SizeOf(Character) : *buff\c = 'e' 
           Case 'ü' : *buff\c = 'u' :  *buff + SizeOf(Character) : *buff\c = 'e' 
           Case 'ß' : *buff\c = 's' :  *buff + SizeOf(Character) : *buff\c = 's'              
           Default  : *buff\c = *text\c               
        EndSelect
      Else
        *buff\c = *text\c               
      EndIf

Re: Umlaute ersetzen, geht das schneller ?

Verfasst: 21.03.2019 13:24
von NicTheQuick
Ich würde wahrscheinlich eine Lookuptable nutzen, also ein Array mit allen Mappings von alt zu neu. Solange das in den Cache der CPU passt, geht das auch fix. Und solange man den abzudeckenden Bereich ganz gut einschränken kann, muss das Array nicht mal besonders groß sein.

Re: Umlaute ersetzen, geht das schneller ?

Verfasst: 21.03.2019 20:13
von hjbremer
Nun das mit der If Abfrage ist schon ganz gut, aber ohne else

Ein Array bedeutet eine Schleife und eine If Abfrage. Also im Grunde das Gleiche wie Select.
Es wird nur unübersichtlicher finde ich. Aber mal schauen

Code: Alles auswählen

;Debugger aus !!!

Procedure.s ReplaceUmlaute(*text.Character)
   
   ;Ä ä Ö ö Ü ü ß "
   ;AeaeOeoeUeuess"
   
   Protected newlg = MemoryStringLength(*text, #PB_ByteLength) * 2
   
   Protected new$, *buff.Character = AllocateMemory(newlg) , mem = *buff
   
   While *text\c        ;1.Zeichen im Text bei Start
      
      *buff\c = *text\c ;erstmal zuweisen und dann erst Umlaute prüfen, gegebenenfalls *buff ändern
      
      If *text\c >= 'Ä'
         Select *text\c
            Case 'Ä' : *buff\c = 'A' : *buff + SizeOf(Character) : *buff\c = 'e'
            Case 'Ö' : *buff\c = 'O' : *buff + SizeOf(Character) : *buff\c = 'e' 
            Case 'Ü' : *buff\c = 'U' : *buff + SizeOf(Character) : *buff\c = 'e'
            Case 'ä' : *buff\c = 'a' : *buff + SizeOf(Character) : *buff\c = 'e'
            Case 'ö' : *buff\c = 'o' : *buff + SizeOf(Character) : *buff\c = 'e' 
            Case 'ü' : *buff\c = 'u' : *buff + SizeOf(Character) : *buff\c = 'e' 
            Case 'ß' : *buff\c = 's' : *buff + SizeOf(Character) : *buff\c = 's'  
            Case $1E9E: *buff\c = 'S': *buff + SizeOf(Character) : *buff\c = 'S'  ;großes ß
         EndSelect 
      EndIf      
      
      *text + SizeOf(Character) ;zum nächsten Zeichen im Text
      *buff + SizeOf(Character) ;zum nächsten Zeichen im Textbuffer
      
   Wend
   
   new$ = PeekS(mem): FreeMemory(mem)

   ProcedureReturn new$
EndProcedure

max = 100000
text$ = "Über Äh ÖÄpfel Rüben Straße ärgert Ösäl ÀÁÂÃ ß" + Chr($1E9E)

s = ElapsedMilliseconds()
For j = 1 To max
   xx$ = text$:    
   xx$ = ReplaceString(xx$, "Ä", "Ae")
   xx$ = ReplaceString(xx$, "Ü", "Ue")
   xx$ = ReplaceString(xx$, "Ö", "Oe") 
   xx$ = ReplaceString(xx$, "ä", "ae") 
   xx$ = ReplaceString(xx$, "ü", "ue") 
   xx$ = ReplaceString(xx$, "ö", "oe") 
   xx$ = ReplaceString(xx$, "ß", "ss") 
   
Next
ss = ElapsedMilliseconds() - s

s = ElapsedMilliseconds()
For j = 1 To max 
   new$ = ReplaceUmlaute(@text$)
Next
su = ElapsedMilliseconds() - s

info$ + text$ + #LF$ + #LF$
info$ + xx$  + " -PB:" + #TAB$ + Str(ss) + #LF$

info$ + new$ + " -ich" + #TAB$ + Str(su) + #LF$


MessageRequester("", info$)
PS: die Sache mit den Arrays ist in Arbeit

Re: Umlaute ersetzen, geht das schneller ?

Verfasst: 21.03.2019 20:33
von NicTheQuick
Mit Array meinte ich eher, dass du den Unicode direkt als Index nutzt.
Sowas in der Art:

Code: Alles auswählen

Dim charMap.u(65535)

charMap(' ') = '!'

Procedure.s replaceCharMap(*input.Character, Array charMap.u(1))
	While *input\c
		If charMap(*input\c)
			*input\c = charMap(*input\c)
		EndIf
		*input + SizeOf(Character)
	Wend
EndProcedure

Define s.s = "Das ist ein Satz mit Ausrufezeichen "

replaceCharMap(@s, charMap())

Debug s

Re: Umlaute ersetzen, geht das schneller ?

Verfasst: 21.03.2019 22:15
von STARGÅTE
Hier mal meine Idee:

Code: Alles auswählen

;Debugger aus !!!


; Initialisierung
Global Dim LookupTable.l($FFFF)
Define Ii
For I= 0 To $FFFF
	LookupTable(I) = I
Next
LookupTable('Ä') = 'eA'
LookupTable('Ö') = 'eO'
LookupTable('Ü') = 'eU'
LookupTable('ä') = 'ea'
LookupTable('ö') = 'eo'
LookupTable('ü') = 'eu'
LookupTable('ß') = 'ss'
LookupTable($1E9E) = 'SS'


; STARGÅTEs Prozedur
Procedure.s FastReplaceUmlaute(*Text.Character)
	
	Static *Buffer : *Buffer = ReAllocateMemory(*Buffer, MemoryStringLength(*Text, #PB_ByteLength)*2)
	Protected *Position.Long = *Buffer
	
	While *Text\c
		*Position\l = LookupTable(*Text\c)
		If *Position\l & ~$FFFF
			*Position + SizeOf(Character)*2
		Else
			*Position + SizeOf(Character)
		EndIf
		*Text+ SizeOf(Character)
	Wend
	
	ProcedureReturn PeekS(*Buffer, (*Position-*Buffer)/SizeOf(Character))
	
EndProcedure


Procedure.s ReplaceUmlaute(*text.Character)
   
   ;Ä ä Ö ö Ü ü ß "
   ;AeaeOeoeUeuess"
   
   Protected newlg = MemoryStringLength(*text, #PB_ByteLength) * 2
   
   Protected new$, *buff.Character = AllocateMemory(newlg) , mem = *buff
   
   While *text\c        ;1.Zeichen im Text bei Start
      
      Select *text\c
         Case 'Ä' : *buff\c = 'A' :  *buff + SizeOf(Character) : *buff\c = 'e'
         Case 'Ö' : *buff\c = 'O' :  *buff + SizeOf(Character) : *buff\c = 'e' 
         Case 'Ü' : *buff\c = 'U' :  *buff + SizeOf(Character) : *buff\c = 'e'
         Case 'ä' : *buff\c = 'a' :  *buff + SizeOf(Character) : *buff\c = 'e'
         Case 'ö' : *buff\c = 'o' :  *buff + SizeOf(Character) : *buff\c = 'e' 
         Case 'ü' : *buff\c = 'u' :  *buff + SizeOf(Character) : *buff\c = 'e' 
         Case 'ß' : *buff\c = 's' :  *buff + SizeOf(Character) : *buff\c = 's'              
         Default  : *buff\c = *text\c               
      EndSelect     
      *text + SizeOf(Character) ;zum nächsten Zeichen im Text
      *buff + SizeOf(Character) ;zum nächsten Zeichen im Textbuffer
      
   Wend
   
   new$ = PeekS(mem): FreeMemory(mem)

   ProcedureReturn new$
EndProcedure

max = 100000
text$ = "Über Äpfel Rüben Straße ärgert Ösil + Bär" 

s = ElapsedMilliseconds()
For j = 1 To max
   xx$ = text$:    
   xx$ = ReplaceString(xx$, "Ä", "Ae")
   xx$ = ReplaceString(xx$, "Ü", "Ue")
   xx$ = ReplaceString(xx$, "Ö", "Oe") 
   xx$ = ReplaceString(xx$, "ä", "ae") 
   xx$ = ReplaceString(xx$, "ü", "ue") 
   xx$ = ReplaceString(xx$, "ö", "oe") 
   xx$ = ReplaceString(xx$, "ß", "ss") 
   
Next
ss = ElapsedMilliseconds() - s

s = ElapsedMilliseconds()
For j = 1 To max 
   new$ = ReplaceUmlaute(@text$)
Next
su = ElapsedMilliseconds() - s

s = ElapsedMilliseconds()
For j = 1 To max 
   fast$ = FastReplaceUmlaute(@text$)
Next
sv = ElapsedMilliseconds() - s

info$ + #LF$
info$ + xx$  + " -PB:" + #TAB$ + Str(ss) + #LF$

info$ + new$ + " -ich" + #TAB$ + Str(su) + #LF$

info$ + fast$ + " -STARGÅTE" + #TAB$ + Str(sv) + #LF$


MessageRequester("", info$)
---------------------------

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

Ueber Aepfel Rueben Strasse aergert Oesil + Baer -PB: 318
Ueber Aepfel Rueben Strasse aergert Oesil + Baer -ich 120
Ueber Aepfel Rueben Strasse aergert Oesil + Baer -STARGÅTE 74

---------------------------
OK
---------------------------

Re: Umlaute ersetzen, geht das schneller ?

Verfasst: 21.03.2019 22:27
von hjbremer
Klasse !!!!!
Alle Zeiten sind UTC+02:00
Seite 1 von 3

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de