Seite 1 von 1

Aufsteigende Strings

Verfasst: 27.06.2008 17:13
von cxAlex
Hier hab ich eine Funktion um aufsteigende Strings zu erzeugen (z.B.: a,b,c,...,ay,az,ba,bb,....,azy,azz,zaa,...)

Könnte vielleicht jemand brauchen.

Code: Alles auswählen

Structure StrPMut
  Chars.s
  cMax.l
  cPos.l
  plen.l
  pPos.l[10000]
  Pref.s
EndStructure

Procedure.s GetNextString(*obj.StrPMut)
  Protected RtVar.s,i
  *obj\cPos+1
  RtVar = *obj\Pref+Mid(*obj\Chars,*obj\cPos,1)
  If Not *obj\cMax
    *obj\cMax = Len(*obj\Chars)
  EndIf
  If *obj\cMax = *obj\cPos
    *obj\cpos=0
    *obj\pPos[*obj\plen]+1
    For i = *obj\plen To 0 Step -1
      If *obj\pPos[i] > *obj\cMax
        *obj\pPos[i] = 1
        If Not i
          *obj\plen+1
          *obj\pPos[*obj\plen] = 1
        Else
          *obj\pPos[i-1]+1
        EndIf
      EndIf
    Next
    *obj\Pref = ""
    For i = 0 To *obj\plen
      *obj\Pref+Mid(*obj\Chars,*obj\pPos[i],1)
    Next
  EndIf
  ProcedureReturn RtVar
EndProcedure


; Testen
Test.StrPMut
Test\Chars = "abcdefghijklmnopqrstuvwxyz" ; Mögliche Zeichen

For i = 1 To 1000
  Debug GetNextString(@Test)
Next

Verfasst: 27.06.2008 18:09
von AND51
Ich fühlte mich herausgefordert :lol: und habe etwas zusammengebastelt.
Ohne den ganzen Schnikschnack mit deiner Struktur, etc.
  • - Erkennt automatisch Groß- und Kleinschreibung
    - Nur der String muss übergeben werden
    - Wird ein Leerstring übergeben, fängt der Code automatisch bei "a" an
    - Extrem schnell, da nur ein Pointer benötigt wird und rekursiv gearbeitet wird

Code: Alles auswählen

Procedure.s IncString(String.s)
	Protected *pos.Character=@String+MemoryStringLength(@String)<<#PB_Compiler_Unicode-SizeOf(Character)
	If String ;And *pos\c <= 'z' ; uncomment this for more safety but less speed
		*pos\c+1
		If *pos\c = 'z'+1
			ProcedureReturn IncString(PeekS(@String, (*pos-@String)>>#PB_Compiler_Unicode))+"a"
		ElseIf *pos\c = 'Z'+1
			ProcedureReturn IncString(PeekS(@String, (*pos-@String)>>#PB_Compiler_Unicode))+"A"
		EndIf
		ProcedureReturn String
	EndIf
	ProcedureReturn "a"
EndProcedure


Repeat
     text.s=IncString(text)
     Debug text
     Delay(200)
ForEver
Diese revolutionäre Version deines Codes zeigt sehr schön, wie man sich die Rekursivität zunutze machen kann!