高分求一特殊的string排序算法！

Question

有一个tstringlist，保存着下列样式的字符串：
a1
a5
a10
a2
a5a
a11
a5b
....
若按字符排序得到的结果是：
a1
a10
a11
a2
a5
a5a
a5b
...
要求排序成：
a1
a2
a5
a5a
a5b
a10
a11
....补充说明：
字符串结构为：N个字符前缀(范围：a..z)+数字(范围1..1000000)+N个字符后缀（范围：a..x)。
字符要以asic排序，数字则按自然数列排序。求实现排序的算法，效率要尽量高一点，最笨的算法我自己能做出来....

Answer 1

a1
a2
a5
a5a
a5b
a10
a11
先按第一个字符排序,再按最后一个字符排序,再按中间数值排序
复杂,关注...

Answer 2

没法子，我正在做的一个东东，字符就是这样的。
最初我的基本思路是：比较再个字符串谁大谁小，就查找第一个字符若属于a..z，若不同可立即比较出，若相同就查下一个字符。若出现数字，就麻烦了！要分别查后面是不是还是数字。然后再strtoint后又进行比较。
若不同可排序，若相同则需要查后面是不是有字符，又按字符进行比较……所以效率低得可怕……

Answer 3

就这样做出一个sub后，在一个循环里比较tstringlist里的所有值，最后输出排序结果……

Answer 4

看错了,解决思路有一点:
1.第一个字符排序,得到a..z开头的几个子TStringList
2.截取中间数值,如果最后一个是a..x的字符,就先把它去掉
3.然后再按最后一个字符排序
1<-2<-3嵌套执行

Answer 5

先排除后面带字符的串；
按字符串长度优先排序，相同长度按数值大小排序；
然后再把与排好的前面部分(a5)相同的后面带字符的串(a5b,a5a,a5c)排序插入在排好的串(a5)后面

Answer 6

我的做法如下：先将字符串做处理——将中间的数字部分改成0000001的定长格式，在排序，最后在去掉多余的0：这个程序我已经写好了，delphi2005下运行通过。排序使用的快速排序。代码如下：
program SortString;{$APPTYPE CONSOLE}
uses
  StrUtils;var
  ss: array of string;
  m, n: Integer;procedure QuickSort(s,e: Integer);
var
  i, j: Integer;
  t: string;
begin
  if s >= e then
    Exit;  t := ss[s];
  i := s;
  j := e;
  while i < j do
  begin
    while (ss[j]>=t) and (i < j) do
      Dec(j);
    ss[i] := ss[j];
    while (ss[i]<=t) and (i < j) do
      Inc(i);
    ss[j] := ss[i];
  end;
  ss[i] := t;  QuickSort(s, i-1);
  QuickSort(i+1, e);
end;procedure Prepare;
var
  i, j: Integer;
  a, b, c, t: string;
begin
  for i:= 0 to m-1 do
  begin
    a := LeftStr(ss[i], n);
    for j := Length(ss[i]) downto 1 do
      if (ss[i, j] >= '0') and (ss[i, j] <= '9') then
        break;
    c := RightStr(ss[i], Length(ss[i])-j);
    b := MidStr(ss[i], n+1, j-n);
    SetLength(t, 8-Length(b));
    for j:=1 to Length(t) do
      t[j] := '0';
    ss[i] := a+t+b+c;
  end;
end;procedure Finish;
var
  i, j: Integer;
  a, b: string;
begin
  for i:=0 to m-1 do
  begin
    for j:=n+1 to Length(ss[i]) do
      if ss[i, j]<>'0' then
        break;
    a := LeftStr(ss[i], n);
    b := RightStr(ss[i], Length(ss[i])-j+1);
    ss[i] := a + b;
  end;
end;var
  i: Integer;
  fv: TextFile;
begin
  AssignFile(fv, 'in.txt');
  Reset(fv);
  Readln(fv, m, n);
  SetLength(ss,m);
  for i:=0 to m-1 do
    Readln(fv, ss[i]);
  CloseFile(fv);  PrePare;
  QuickSort(0, m-1);
  Finish;  AssignFile(fv, 'out.txt');
  ReWrite(fv);
  for i:=0 to m-1 do
    Writeln(fv, ss[i]);
  CloseFile(fv);  ss := nil;end.有更好办法的人们，至少给个思想呵。

Answer 7

这个很简单啊
第一步：格式化Tstringlist的所有字符串，前缀和后缀是固定的，因此只需要取中间一部分，那么我们将中间部分的长度定死为8位，不足者前面补零。这样你的字符串长度一样，不久好比较了吗？
第二步：不说了，就是用sort
第三步：再转换过来：strtoint+inttostr即可

Answer 8

楼上所说的可能满足不了楼主要求，因为楼主的数字长度是不固定的，单是完成你所说的格式化就够受的了，以下是我写的算法，仅供参考。
unit Sort;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    ListBox2: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure SortStr(var StrArray:Array of String;Up:Boolean=True);
  function CompStr1AndStr2(var Str1,Str2:String;Up:Boolean):Boolean;
  var
     L1,L2,N1,N2:Integer;
     c1,c2:Char;
  begin
     if Str1[1]>Str2[1] then
          Result:=True
     else
          if Str1[1]<Str2[1] then
               Result:=False
          else
          begin
               L1:=Length(Str1);
               L2:=Length(Str2);
               c1:=#1;
               if Str1[L1] in ['a'..'x'] then
               begin
                    N1:=StrToInt(Copy(Str1,2,L1-2));
                    c1:=Str1[L1];
               end
               else
               begin
                    N1:=StrToInt(Copy(Str1,2,L1-1));
               end;
               c2:=#1;
               if Str2[L2] in ['a'..'x'] then
               begin
                    N2:=StrToInt(Copy(Str2,2,L2-2));
                    c2:=Str2[L2];
               end
               else
               begin
                    N2:=StrToInt(Copy(Str2,2,L2-1));
               end;
               if N1>N2 then
                    Result:=True
               else
                    if N2>N1 then
                         Result:=True
                         else
                              Result:=(c1>c2);
          end;
          if Not Up then Result:=Not Result;
  end;
  procedure SwapStr(var Str1,Str2:String);
  var
     TStr:String;
  begin
     TStr:=Str1;
     Str1:=Str2;
     Str2:=TStr;
  end;
  procedure QuickSort(var A: array of String; iLo, iHi: Integer);
  var
    Lo, Hi: Integer;
    Mid:String;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while CompStr1AndStr2(Mid,A[Lo],Up) do Inc(Lo);
      while CompStr1AndStr2(A[Hi],Mid,Up) do Dec(Hi);
      if Lo <= Hi then
      begin
        SwapStr(A[Lo], A[Hi]);
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(A, iLo, Hi);
    if Lo < iHi then QuickSort(A, Lo, iHi);
  end;
begin
  QuickSort(StrArray, Low(StrArray), High(StrArray));
end;procedure TForm1.Button1Click(Sender: TObject);
const ln=1000;
var
     StrA:Array[0..ln] of String;
     i:Integer;
     s1,s2:String;
begin     for i:=0 to ln do //产生一些数据用于测试。
     begin
          StrA[i]:=Chr(Random(25)+Ord('a'))+IntToStr(Random(10000))+Chr(Random(22)+Ord('a'));
          ListBox1.Items.Add(StrA[i]);
     end;
     SortStr(StrA);
     for i:=0 to ln do
     begin
          ListBox2.Items.Add(StrA[i]);
     end;
     s1:='qasdfasdf';
     s2:='wwwww';
end;end.

Answer 9

zzlingaaa(小舟)朋友：
看错了,解决思路有一点:
1.第一个字符排序,得到a..z开头的几个子TStringList
2.截取中间数值,如果最后一个是a..x的字符,就先把它去掉
3.然后再按最后一个字符排序
1<-2<-3嵌套执行第2步时，字符串最后不一定只有一个字符，可能是几个字符……于是只有逐个检查……

Answer 10

Samland(samland) 朋友：在按字符串长度优先排序时，我举一个反例：
a12和ab1
它们是相同的长度，但a12应该排在ab1的前面……按字符串长度优先排序，相同长度按数值大小排序；这部分，就是我最初的基本思路。
QuickKeyBoard()朋友：你的办法对我来说是个全新思路！谢谢，我再好好研究一下代码。

Answer 11

XuDunYu(西门吹雪)朋友：前后缀可不是固定的，如a1,b1,a2，此时应该排成a1,a2,b1啊wizardqi(男巫)朋友：你的代码我也好好研究一下，谢谢！

Answer 12

procedure sort(s:Tstringlist);
var
  x,i,j:integer;
  s0,s1:string;
  function isdigit(x:char):boolean;
  begin
    Result := True;
    if (ord(x)<$30) or (ord(x)>$39) then
       Result := False;
  end;
begin
  for i:= 0 to s.count-1 do
  begin
    s0 := s[i];
    for j:=2 to length(s) do 
      if not isdigit(s[i]) then break;
    if j<=lengh(s) then
    begin
      s1 := copy(s0,2,j-2);
      x := inttostr(s1);
      s1 := copy(inttostr(100000000+x),2,8);
      s1 := s[1]+s1+copy(s0,j,Length(s0)-j+1);
    end else s1 := s;
    s[i] := s1;
  end;
  s.sort; 
end;

Answer 13

>>zzlingaaa(小舟)朋友：
看错了,解决思路有一点:
1.第一个字符排序,得到a..z开头的几个子TStringList
2.截取中间数值,如果最后一个是a..x的字符,就先把它去掉
3.然后再按最后一个字符排序
1<-2<-3嵌套执行第2步时，字符串最后不一定只有一个字符，可能是几个字符……于是只有逐个检查……有几个字符有什么关系,只要全部是字符,排序就是很简单的

Answer 14

function SortCompare(List: TStringList; Index1, Index2: Integer): Integer;  procedure ParseStr(source:string;out a1, a2, a3:string);
  var
    p1,p2,p3,q:pchar;
    n,i:integer;
    s:string;
  begin
    p1:=pchar(source);
    n:=length(source);    q:=p1;
    while (q^ >='a')and (q^<='z') and (q<p1+n) do
      inc(q);
    a1:=Copy(p1,0,q-p1);
    p2:=q;
    while (q^ >='0')and (q^<='9') and (q<p1+n) do
      inc(q);
    a2:=Copy(p2,0,q-p2);
    p3:=q;
    while (q^ >='a')and (q^<='x') and (q<p1+n) do
      inc(q);
    a3:=Copy(p3,0,q-p3);
  end;var
  a1,a2,a3:string;
  b1,b2,b3:string;  I : Integer;
begin
//
  ParseStr(List.Strings[Index1],a1,a2,a3);
  ParseStr(List.Strings[Index2],b1,b2,b3);  i:=CompareStr(a1,b1);
  if i=0 then
  begin
    i:=Length(a2)-Length(b2);
    if i=0 then
    begin
      i:=CompareStr(a2,b2);//比数字.
      if i=0 then
      begin
        Result:=CompareStr(a3,b3);
      end
      else
        Result:=i;
    end
    else
      Result:=i;
  end
  else
    Result:=i;end;procedure TForm1.Button1Click(Sender: TObject);
var
  strs:TStringList;
begin
  strs:=TStringList.Create;
  strs.Text:=Memo1.Text;
  strs.CustomSort(SortCompare);
  Memo2.Text:=strs.Text;
  strs.Free;end;