Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2006.12.17;
Скачать: [xml.tar.bz2];

Вниз

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

 
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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.042 c
15-1164612921
malefik
2006-11-27 10:35
2006.12.17
> Стабильность .....TServerSocket


3-1160373460
jbond
2006-10-09 09:57
2006.12.17
Работа из Turbo Delphi Explorer с SQLite


4-1155441360
wiln
2006-08-13 07:56
2006.12.17
Использование мыши для перемещения окна


15-1164232592
Горгер
2006-11-23 00:56
2006.12.17
Книги, которые пишут женщины, могут читать только женщины


9-1140343244
ErikD
2006-02-19 13:00
2006.12.17
HELP





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский