String intelligent Kürzen

[BBoy]

Habe folgendes Problem. Ein String der eine Bezeichnung enthält muss auf 14 Zeichen gekürzt werden. Aber nicht einfach abgeschnitten, sondern eben Intelligent.

1. Aus der Bezeichnung sollen alle Sonderzeichen und Satzzeichen entfernt werden. nur a-z, A-Z und 0-9 sollen erhalten bleiben
2. Ist am Ende der Bezeichnung eine Zahl so muss diese erhalten bleiben
3. Aus der Bezeichnung sollen alle Leerzeichen entfernt werden.

Ich denke man müsste zuerst berechnen wie viele Worte der String hat, und dann von jedem Wort ein paar Anfangsbuchstaben nehmen. Wobei es gut wäre wenn vom ersten Wort mehr Buchstaben genommen werden als von den nächsten. Zudem muss jeder Name einmalig sein. Sollte ein Name doppelt sein, müsste dieser anders benannt werden.

Bsp:
aus "Kitho´s Serie Teil 3" sollte "KithoSeriTeil3" werden.
aus "Lorscher Geschichte 'Laurissa'" sollte "LorschGescLaur" werden
aus "Die Rheinblick Serie 12" sollte "DieRheinblSe12" werden.

Hat von euch jemand eine Idee wie ich das verwirklichen kann?
Danke!

[mkinzler]

-Zuerst die Überprüfung/ggf Trennung der Zahl
-Druchgehen Rest und Zeichen Löschen wenn nicht in [0..9][a..Z] oder leerzeichen
-Trenner nach Wörter
-Berechnung Buchstaben pro Wort: Restlänge ( 14 - Länge Zahl) / Anzahl Wörter
-Kopieren der Buchstaben
-Zahl wieder anhängen

[BBoy]

Vor allem mit diesem Punkt habe ich Probleme: -Berechnung Buchstaben pro Wort: Restlänge ( 14 - Länge Zahl) / Anzahl Wörter
Könnte mir das bitte jemand anhand dieses Beispiels erklären: aus "Lorscher Geschichte 'Laurissa'" sollte "LorschGescLaur" werden ?? Ein Codeschnipsel wäre super, da ich echt kein plan habe wie ich das machen soll.

[mkinzler]

In etwa so

Delphi-Quellcode:

function KuerzeDateiname( orig: string): string;
var
  sl: TStrings;
  s: string;
  i, j, g, ab: Integer;
begin
   //Ungueltige Zeichen entfernen
   s := '';
   for i := 1 to length( orig) do
   begin
       if orig[i] in [' ', 'a'..'z', 'A'..'Z'] then
           s := s + orig[i];
   end;
   //Nach Wörter trennen
   try
        sl := TStringList.Create;
        sl.Delimiter := ' ';
        sl.StrictDelimiter := True;
        sl.DelimitedText := s;
        ab := 14 DIV sl.Count; //Anzahl Buchstaben pro Wort
        for i := 0 to sl.Count -1 do
        begin
            g := min( Length( sl[i]), ab);
            for j := 1 to g do
            begin
                result := result + sl[i][j];
            end;
        end;
   finally
       sl.Free;
  end;
end;

Es besteht natürlich noch Überarbeitungsbedarf

[BBoy]

Danke.

Zitat:

Es besteht natürlich noch Überarbeitungsbedarf ( z.B. wenn ein Wort kürzer ist, als die zu kopierende Anzahl von Buchstaben)

Aber eben darin sehe ich ein Problem das ich nicht zu lösen weiß. Denn wenn wörter kürzer sind, soll es ja von den vorherigen dementsprechend mehr Buchstaben nehmen, aber auch das muss erst geprüft werden ob da genug vorhanden sind. Wenn nicht muss er vom nächsten Wort mehr Buchstaben nehmen aber auch da muss erst wieder geprüft werden ob es geht. Und genau das wir schwer finde ich..... oder gibt es da eine Möglichkeit das doch recht einfach zu lösen?

[mkinzler]

Ich habe den Code nochmal etwas überarbeitet/erweitert

-es werden nun Zahlen am Ende erhalten
-man kann die Ziellänge angeben
-Unterdeckungen ( weil Wort zu kurz) wird auf andere Wörter verteilt

Delphi-Quellcode:

function KuerzeDateiname( orig: string; nlen: Integer): string;
var
  sl: TStrings;
  s, s2: string;
  i, j, g, k, ab: Integer;
begin
   k := 0;
   //Zahl am Ende erkennen und abtrennen
   s2 := '';
   i := length( orig);
   while orig[i] in [ '0'..'9'] do
       dec(i);
   if i <  length( orig) then
   begin
       s2 := Copy( orig, i+1, length(orig) - i + 1 );
       Delete( orig, i+1, length( orig) - i + 1);
       nlen := nlen - Length(s2) - 1;
   end;
   //Ungueltige Zeichen entfernen
   s := '';
   Orig := Trim(Orig);
   for i := 1 to length( orig) do
   begin
       if orig[i] in [' ', 'a'..'z', 'A'..'Z'] then
           s := s + orig[i];
   end;
   //Nach Wörter trennen
   try
        sl := TStringList.Create;
        sl.Delimiter := ' ';
        sl.StrictDelimiter := True;
        sl.DelimitedText := s;
        ab := nlen DIV sl.Count; //Anzahl Buchstaben pro Wort
        for i := 0 to sl.Count -1 do
        begin
            g := min( Length( sl[i]), ab+k);
            if Length( sl[i]) < ab+k then
                k := ab+k - Length( sl[i])
            else
                k := 0;
            for j := 1 to g do
            begin
                result := result + sl[i][j];
            end;
        end;
        result := result + s2;
   finally
       sl.Free;
  end;
end;

[BBoy]

Hey echt cool was du da einfach so hervor zauberst, vielen Dank!!

Allerdings stimmt das Ergebnis manchmal nicht. So macht er aus "Lorscher Geschichte Laurissa" folgendes "LorsGescLaur" also nur 12 Zeichen anstatt 14. Und bei "Geschichte der La" macht er nur "GescderLa" 9 Zeichen.
Woran liegt das? Leider verstehe ich deinen Code nicht genug um selbst den Grund zu finden.

[himitsu]

Er errechnet die Zeichen pro Wort und rundet dann ab, also muß da zwangsläufig ab und zu mal weniger rauskommen.

[mkinzler]

Ich habe ja geschrieben, dass der code nicht optimal ist, sondern nur einen möglichen Lösungsweg zeigen soll

Man könnte z.B. statt immer Abzurunden ( DIV ) Runden und dann am Ende den String auf die gewünschte Anzahl ( nlen abzgl. Länge Zahl) Trimmen, dann wre u.U die Anzahl der Buchstaben des letzten Worts weniger bzw. es würde dann komplett fehlen

[himitsu]

Delphi-Quellcode:

function KuerzeDateiname(S: String; Len: Integer): String;
var
  i, i2: Integer;
  SL: TStrings;
begin
  // ungültige Zeichen entfernen
  for i := Length(S) downto 1 do
    if not (S[i] in [' ', 'a'..'z', 'A'..'Z', '0'..'9']) then
      Delete(S, i, 1);
  // ungültige Zahlen entfernen
  while (i > 0) and (S[i] in ['0'..'9']) do
    Dec(i);
  for i := i downto 1 do
    if S[i] in ['0'..'9'] then
      Delete(S, i, 1);
  //
  SL := TStringList.Create;
  try
    // String aufsplitten
    SL.LineBreak := '';
    SL.Delimiter := ' ';
    SL.StrictDelimiter := True;
    SL.DelimitedText := S;
    // längstes Wort suchen
    i2 := 0;
    for i := SL.Count -1 downto 0 do
      i2 := Max(i2, Length(SL[i]));
    // Anzahl der zu entfernenden Zeichen
    Len := Length(SL.Text) - Len;
    // kurze Wörter (Einzelbuchstaben) entfernen
    i := SL.Count - 1;
    while (Len > 0) and (i >= 0) do begin
      if Length(SL[i]) = 1 then begin
        SL.Delete(i);
        Dec(Len);
      end;
      Dec(i);
    end;
    // Wörter kürzen
    i := -1;
    while (Len > 0) do begin
      if i < 0 then begin
        i := SL.Count - 1;
        Dec(i2);
      end;
      if Length(SL[i]) > i2 then begin
        SL[i] := Copy(SL[i], 1, i2);
        Dec(Len);
      end;
      Dec(i);
    end;
    // Text zusammensetzen und ausgeben
    Result := SL.Text;
  finally
    SL.Free;
  end;
end;

Bezüglich den doppelten Ergbnissen:
da müßte man jetzt bei Result := SL.Text; prüfen ob es das schon gibt, zu // String aufsplitten zurückspringen ('ne Repeat-Schleife mit Prüfung auf Doppeltes am Ende) und dann beim wiederholten Durchlauf einige der Löschungen überspringen und das dann solange bis es am Ende einzigartig ist.

Wie viele Buchstaben müssen denn im Durchschnitt gelöscht werden?
Jenachdem müßte man die Löschüberspringverwaltung erstellen (bis 32 = Integer, bis 64 = Int64, bis 256 = Set of Byte, mehr = Liste).