Umlaute ersetzen, geht das schneller ?

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.
Antworten
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

Umlaute ersetzen, geht das schneller ?

Beitrag 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$)
Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer
Nach oben
Benutzeravatar
mk-soft
Beiträge: 3701
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Umlaute ersetzen, geht das schneller ?

Beitrag 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.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Nach oben
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6999
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:
Kontaktdaten von STARGÅTE

Re: Umlaute ersetzen, geht das schneller ?

Beitrag 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).
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Nach oben
Benutzeravatar
juergenkulow
Beiträge: 188
Registriert: 22.12.2016 12:49
Wohnort: :D_üsseldorf-Wersten

Re: Umlaute ersetzen, geht das schneller ?

Beitrag 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ß
Bitte stelle Deine Fragen, denn den Erkenntnisapparat einschalten entscheidet über das einzig bekannte Leben im Universum.

Jürgen Kulow Wersten :D_üsseldorf NRW D Europa Erde Sonnensystem Lokale_Flocke Lokale_Blase Orion-Arm
Milchstraße Lokale_Gruppe Virgo-Superhaufen Laniakea Sichtbares_Universum
Nach oben
Benutzeravatar
Josh
Beiträge: 1028
Registriert: 04.08.2009 17:24

Re: Umlaute ersetzen, geht das schneller ?

Beitrag 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
Nach oben
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8679
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:
Kontaktdaten von NicTheQuick

Re: Umlaute ersetzen, geht das schneller ?

Beitrag 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.
Bild
Nach oben
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

Re: Umlaute ersetzen, geht das schneller ?

Beitrag 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
Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer
Nach oben
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8679
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:
Kontaktdaten von NicTheQuick

Re: Umlaute ersetzen, geht das schneller ?

Beitrag 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
Bild
Nach oben
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6999
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:
Kontaktdaten von STARGÅTE

Re: Umlaute ersetzen, geht das schneller ?

Beitrag 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
---------------------------
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Nach oben
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

Re: Umlaute ersetzen, geht das schneller ?

Beitrag von hjbremer »

Klasse !!!!!
Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer
Nach oben
Antworten

Zurück zu „Code, Tipps und Tricks“