zeichenkette erstellen

[gammatester]

Am einfachsten geht's wohl rekursiv. Hier ein Beispielcode

Delphi-Quellcode:

{$apptype console}
program kette;

const
  maxlen = 3;
  zeichen: string='abc';

procedure genlen(pre: string; len: integer);
var
  i: integer;
begin
  if len<2 then for i:=1 to length(zeichen) do writeln(pre,zeichen[i])
  else for i:=1 to length(zeichen) do genlen(pre+zeichen[i],len-1)
end;

var
  len: integer;
begin
  for len:=1 to maxlen do genlen('', len);
end.

mit der Ausgabe:

Code:

a
b
c
aa
ab
ac
ba
bb
bc
ca
cb
cc
aaa
aab
aac
aba
abb
abc
aca
acb
acc
baa
bab
bac
bba
bbb
bbc
bca
bcb
bcc
caa
cab
cac
cba
cbb
cbc
cca
ccb
ccc

[mfrank]

ja, genau dies habe ich gesucht - es funktioniert prima und ist auch nachvollziehbar.
Vielen Dank
Michael

[Horst_]

Hallo,

falls Du nur die Anzahl der verschiedenen Möglichkeiten brauchst, kannst Du diese ja jetzt leicht berechnen.
Bei k verschiedenen Zeichen mit Länge l ergibt sich
Anzahl = Summe (i= 1 bis l) [k^i]
Im Beispiel hier k=3 und l = 3
ergibt Anzahl= 3^1+3^2+3^3 = 3+9+27 = 39

Ginge die Summe mit i= 0 los ergäbe es die Zinsenszinsformel
q_l = (q^(l+1)-1)/(q-1) mit q = k
Schönerweise ist aber q^0 immer 1 für q <> 0
also geht hier

Anzahl = (k^(l+1)-1)/(k-1) -1

hier also Anzahl = (3^4-1)/2 -1 = 40-1 = 39

[mfrank]

Hallo,
ich muss dieses Thema noch einmal öffnen.
Gibt es auch eine Möglichkeit die Abfrage mit Zeichenketten abzurufen - also nicht abcd sondern 'ab', 'bc', '11'.
Ich habe schon einiges probiert aber noch keine Lösung gefunden.
Viele Grüße
Michael

[Aphton]

Ich weiß nicht, ob du das programmiertechnisch implementiert haben willst, oder ob n programm (dieser thread) schon reicht :/

[Horst_]

Hallo,

ich habe mal die Version von Gammatester erweitert.
Was mich stutzig machte war die Angabe einer Zeichenmenge von '11', was so nicht geht.
Es geht doch um die Erstellung aller Variationen aus einer Zeichenmenge mit einer Länge von 1 bis maxlen, und dabei müßen die Elemente der Menge alle verschieden sein.

Delphi-Quellcode:

{$apptype console}
program kette;
uses  
  sysutils,classes;
  
function MaxCountVariation(AnzahlverschiedeneZeichen,MaxLaengeAusgabe:cardinal):Int64;
var
  i : integer;
begin
  result := 0;
  IF MaxLaengeAusgabe> 0 then  
    begin
    try
      // r = (q^(n+1)-1 )/(q-1) -1
      //q= AnzahlverschiedeneZeichen;n = MaxLaengeAusgabe
      result := AnzahlverschiedeneZeichen;    
      For i := 1 to MaxLaengeAusgabe do
        result := result * AnzahlverschiedeneZeichen;
      result := (result -1)  div (AnzahlverschiedeneZeichen-1)-1;
    except
      writeln('Zuviele Möglchkeiten');
      halt(-2);
    end;    
    end;
end;    


function BereinigeZeichenvorrat(ZV:string):string;
// keine doppelten Zeichen
var
  i,j: integer;
begin
  i := 1;
  while length(ZV)>i do
    begin
    j := i+1;
    while j <=length(ZV) do
      begin
      IF ZV[i]=ZV[j] then
        delete(ZV,j,1)
      else
        inc(j);
      end;
    inc(i);
    end;
  result := ZV; 
end;

function ErzeugeVariationen(ZeichenVorrat:string;
                            Laenge:integer;
                            out SL:TStringlist):boolean;

  var
    pre : string;                          
  procedure genlen(len: integer);
  var
    i: integer;
  begin
    IF len = 1 then
      for i:=1 to length(Zeichenvorrat) do 
        begin
        pre[len]:=Zeichenvorrat[i];
        SL.Add(pre)
        end
   else 
     for i:=1 to length(Zeichenvorrat) do 
       begin
       pre[len]:=Zeichenvorrat[i];
       genlen(len-1)
     end;
   end;      
                      
var
  len,
  cap : integer;
begin
  Zeichenvorrat := BereinigeZeichenvorrat(Zeichenvorrat);
  result := false;
  SL.clear;
  try
    cap := MaxCountVariation(length(Zeichenvorrat),Laenge);
    IF cap < 1000000 then
      begin
      SL.capacity := MaxCountVariation(length(Zeichenvorrat),Laenge);
      for len:=1 to Laenge do 
        begin
        setlength(pre,len); 
        genlen( len);
        end;
        
      result := true;  
      
      if SL.count < 10000 then 
        writeln(SL.text);
      end
    else
      writeln('Zuviele Moeglichkeiten: ',cap,#13#10);
  finally  

  end;  
end;

var
  VariationenListe: TStringlist;

BEGIN
  VariationenListe:= TStringlist.create;
  try
    ErzeugeVariationen('01',2,VariationenListe);
    ErzeugeVariationen('010101010101010101',2,VariationenListe);
    ErzeugeVariationen('0111110000',2,VariationenListe);
    ErzeugeVariationen('12345',1,VariationenListe);
  finally  
    VariationenListe.free;
  end;  
END.

Ausgabe leicht anders als bei gammatester, da die Zeichenfolge rückwärts erstellt wird.

Code:

0
1
00
10
01
11

0
1
00
10
01
11

0
1
00
10
01
11

1
2
3
4
5
11
21
31
41
51
12
22
32
42
52
13
23
33
43
53
14
24
34
44
54
15
25
35
45
55