| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

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

DelphiN! ©   (2005-01-13 11:03:00) 

Нужно отсортировать строки, согласно своим приоритетам каждой буквы, например в обычной сортировке сначало ставиться буква 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;

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

---

DelphiN!   (2005-01-14 08:14:00) [1]

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

---

TUser   (2005-01-13 12:29:00) [2]

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;

---

Anatoly Podgoretsky   (2005-01-13 12:09:00) [3]

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

---

ЮЮ   (2005-01-13 11:13:00) [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;

---

DelphiN!   (2005-01-13 11:11:00) [5]

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


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

---

Alx2   (2005-01-13 11:10:00) [6]

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

---

KSergey   (2005-01-13 11:09:00) [7]

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

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

---

Наверх