Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.12.17;
Скачать: CL | DM;

Вниз

Сортировка массива с сохранением "перестановок"   Найти похожие ветки 

 
Riply ©   (2006-11-29 13:51) [0]

Здравствуйте !
Никак не получается правильно получить "лог сортировки" массива.
Т.е. мне нужно после сортировки иметь возможность обратиться
к элементу массива по его индексу, который был до сортировки.
Пытаюсь делать так:
type
TDWord_Array = array of DWord;

TIndDataEx = packed record
 Ind: Integer;
 Val: DWord;
 Status: DWord;
end;
TIndDataArrEx = array of TIndDataEx;

procedure IndexDataEx_ExchangeItems(var Item1, Item2: TIndDataEx);
var
aInd: integer;
aVal: DWord;
begin
with Item1 do
 begin
  aInd:= Ind;
  Ind:= Item2.Ind;
  Item2.Ind:= aInd;
  aVal:= Val;
  Val:= Item2.Val;
  Item2.Val:= aVal;
  aVal:= Status;
  Status:= Item2.Status;
  Item2.Status:= aVal;
 end;
end;

procedure DWordArr_ExchangeItems(var Item1, Item2: DWord);
var
Tmp: DWord;
begin
Tmp:= Item1;
Item1:= Item2;
Item2:= Tmp;
end;

procedure IndexDataEx_SortData(var idArr: TIndDataArrEx; var ExchArr: TDWord_Array);

procedure Quick_SortDataEx(var A: TIndDataArrEx; iLo, iHi: integer; var Exch: TDWord_Array);
var
 iL, iH, M: integer;
 Mid: DWord;
 bTmp: Boolean;
begin
 iL := iLo;
 iH := iHi;
 M:= (iL + iH) shr 1;
 Mid := A[M].Val;
 M:= A[M].Ind;
 repeat
  bTmp:= False;
  repeat
   if A[iL].Ind < M then inc(iL) else
    if A[iL].Ind > M then bTmp:= True else
     if A[iL].Val < Mid then inc(iL) else bTmp:= True
  until bTmp;
  bTmp:= False;
  repeat
   if A[iH].Ind > M then dec(iH) else
    if A[iH].Ind < M then bTmp:= True else
     if A[iH].Val > Mid then dec(iH) else bTmp:= True;
  until bTmp;

  if iL <= iH then
   begin
    IndexDataEx_ExchangeItems(A[iL], A[iH]);
    DWordArr_ExchangeItems(Exch[iL], Exch[iH]);
    Inc(iL);
    Dec(iH);
   end;
 until iL > iH;
 if iH > iLo then Quick_SortDataEx(A, iLo, iH, Exch);
 if iL < iHi then Quick_SortDataEx(A, iL, iHi, Exch);
end;

begin
Quick_SortDataEx(idArr, Low(idArr), High(idArr), ExchArr);
end;

Потом ищу элемент: idArr[ExchArr[индекс до сортировки]]
Иногда, (не очень часто) получаю не то, что нужно :(
Помогите разобраться, а то я совсем запуталась :(


 
Riply ©   (2006-11-29 14:02) [1]

P.S. Исходно ExchArr заполняется (0, 1, 2, ....


 
Наиль ©   (2006-11-29 17:12) [2]

Примерно так.
procedure Quick_Sort(Dats,Ind:array...);
begin
 ...
 if Dats[Ind[a]]<Dats[Ind[b]] {Поставь своё условие}
  then Swap(Dats,Ind,a,b);
 ...
end;

procedure Swap(...)
begin
 // Поменять значения
 x:=Dats[Ind[a]];
 Dats[Ind[a]]:=Dats[Ind[b]];
 Dats[Ind[b]]:=x;
 // Поменять указатели на значения
 x:=Ind[a];
 Ind[a]:=Ind[b];
 Ind[b]:=x;
end;


 
Leonid Troyanovsky ©   (2006-11-29 21:43) [3]


> Riply ©   (29.11.06 13:51)  

> Т.е. мне нужно после сортировки иметь возможность обратиться
> к элементу массива по его индексу, который был до сортировки.

http://groups.google.com/group/fido7.ru.delphi/msg/8c27f707490716b2

Т.е., в качестве индекса для TStringlist может выступать,
например TList.

--
Regards, LVT.


 
Riply ©   (2006-11-30 10:32) [4]

Всем спасибо огромное !
Изучая, предложенные варианты, поняла в чем дело.
Индексному массиву, полученному после сортировки,
не хватало следующего ( ну очень хитрого :) преобразования :
procedure ConverIndexArr(var ExchArr: array of DWord);
var
i: integer;
TmpArr: array of DWord;
begin
SetLength(TmpArr, Length(ExchArr));
for i:= Low(TmpArr) to High(TmpArr) do TmpArr[ExchArr[i]]:= i;
Move(TmpArr[0], ExchArr[0], Length(ExchArr) * SizeOf(DWord));
end;



Страницы: 1 вся ветка

Текущий архив: 2006.12.17;
Скачать: CL | DM;

Наверх




Память: 0.45 MB
Время: 0.058 c
11-1140581535
LAutour
2006-02-22 07:12
2006.12.17
Возможно ли разместить KOLButton на KOLSplitter?


15-1164793452
skiner
2006-11-29 12:44
2006.12.17
Конфликт с Антивирусом


2-1164897150
Doma
2006-11-30 17:32
2006.12.17
Как сделать TabSheet в PageControl e невидимым?


3-1160476542
RebroFF
2006-10-10 14:35
2006.12.17
Помогите построить запрос


2-1164627544
mmms
2006-11-27 14:39
2006.12.17
Можно ли в TRichEdit вывести текст с фоном произв. цвета?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский