Сортировка, с приоритетом на другие буквы

← →
DelphiN! © (2005-01-13 11:03) [0]

Нужно отсортировать строки, согласно своим приоритетам каждой буквы, например в обычной сортировке сначало ставиться буква A, а мне надо сначало скажем F, второй буквой в стандартной сортировке идет B, а мне надо скажем W и т.д

Вот накатал процедурку, где для каждой буквы можно ставить свой приоритет, согласно которому проходит сортировка, так-же 1-я буква главнее приорететом чем 2-я и т.д. Однако данная процедура работает не так, помоему моя ошибка либо в таблице приоритетов, либо в вычеслении приоритета, согласно номеру буквы в строке(Result := Result+GetAssoc(s[i])+Length(s)-(i);).

Вот вся ф-ия :

procedure _Sort(var strl: TStringList);
//Получить приоритет слова
function GetPrior(s: String): Integer;
//Получить приоритет буквы
function GetAssoc(c: Char): Integer;
begin
case c of
"a": Result := (6*(60))*35;
"b": Result := (5*(50))*35;
"c": Result := (4*(40))*35;
"d": Result := (3*(30))*35;
"e": Result := (2*(20))*35;
"f": Result := (1*(10))*35;

"A": Result := (12*120)*35;
"B": Result := (11*110)*35;
"C": Result := (10*100)*35;
"D": Result := (9*90)*35;
"E": Result := (8*80)*35;
"F": Result := (7*70)*35;
end;
end;
var
i: Integer;
begin
Result := 0;
for i := 0 to Length(s) do
Result := Result+GetAssoc(s[i])+Length(s)-(i);
end;

//Найти минимальное значение слова в стринглисте
function FindMin(strl: TStringList): Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to strl.Count-1 do
if GetPrior(strl.Strings[Result]) < GetPrior(strl.Strings[i]) then
Result := i;
end;

var
i,j,n: Integer;
s: String;
_strl: TStringList;
begin
_strl := TStringList.Create;
while strl.Count > 0 do
begin
//Найти слово с минимальным приоритетом
i := FindMin(strl);
//Добавить это слово в новый список
_strl.Add(strl.Strings[i]);
//Удалить это слово из основного списка
strl.Delete(i);
end;
//присвоить значения нового списка старому
strl := _strl;
end;

Пример :
var
strl: TStringList;
begin
strl := TStringList.Create;
strl.LoadFromFile("C:\1.txt");
_Sort(strl);
strl.SaveToFile("C:\2.txt");
end;

Помогите довести ф-ию до рабочего состояния, ото уже голова не варит ...

← →
KSergey © (2005-01-13 11:09) [1]

> DelphiN! © (13.01.05 11:03)
> Помогите довести ф-ию до рабочего состояния, ото уже голова
> не варит ...

А может просто развеяться?

← →
Alx2 © (2005-01-13 11:10) [2]

А не проще ли сначала заменить буквы согласно приоритетам, а потом, после сортировки, снова заменить их на исходные?

← →
DelphiN! © (2005-01-13 11:11) [3]

> [1] KSergey © (13.01.05 11:09)

Времени нет. :(

← →
ЮЮ © (2005-01-13 11:13) [4]

function CrasyStringCompare(List: TStringList; Index1, Index2: Integer): Integer;
begin
//Result := List.CompareStrings(List.FList^[Index1].FString,
List.FList^[Index2].FString);
// вместо стандартных пишешь свои правила срвнения
end;

TCrasyStringList = class(TStringList)
public
procedure Sort; override;

end;

procedure TCrasyStringList.Sort;
begin
CustomSort(CrasyStringCompare);
end;

← →
Anatoly Podgoretsky © (2005-01-13 12:09) [5]

DelphiN! © (13.01.05 11:11) [3]
А, ну тогда другое дело, отложи пока.

procedure Buble (var S: TSTringList);
var i, j: integer;

function ComnpareStr(S1, S2: string): shortint;
var i1, i2: integer;

function GetValue(C: char): integer;
begin
// Это ты уже написал
end;

begin
i1:=1; i2:=1; f:=true;
result:=0; // equal;
while (result = 0) and
(i1 <= length(S1)) and
(i2 <= length(S2)) do
if GetValue(S1[i1]) < GetValue(S2[i2]) then
result:=-1
else
if GetValue(S1[i1]) > GetValue(S2[i2]) then
result:=1
else begin
// if GetValue(S1[i1]) = GetValue(S2[i2]) then begin
inc (i1); inc (i2);
end;
end;

procedure Swap(I1, I2: integer);
var _s: string;
begin
_s:=S[i1]; S[i1]:=S[i2];
S[i2]:=_s;
end;

begin
for i:=0 to S.Count-2 do
for j:=S.Count-1 downto i do
if CompareStr(S[i],S[j]) < 0 then
Swap(i,j);
end;

Всем огромное спасибо, все прекрасно заработало !

Сортировка, с приоритетом на другие буквы Найти похожие ветки