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

Вниз

Алгоритм прохождения по массиву   Найти похожие ветки 

 
_Max ©   (2005-06-29 12:27) [0]

Подскажите идею, как лучше всего
организовать следующий проход
по массиву с числовыми значениями.

Есть случайная цепочка значений, например

0, 2, 3, 1, 0, 0, 0, 7, 5

Нужно получить массив слудующего вида
2, 3, 1, 7, 5, 0, 0, 0, 0
Т.е. все значения 0 добавить в конец цепочки, а последующий символ передвинуть на его места.

Заранее спасибо.


 
ferr ©   (2005-06-29 12:35) [1]

Просматриваешь с двух концов. Слева ищешь 0, справа не 0. Обмениваешь их.


 
Kolan ©   (2005-06-29 12:36) [2]

Заводишь новый массив такойже длинны. Инициализируешь его 0. Идешь по первому смотриш если не ноль то добавляешь во второй. В итоге получишь что надо.


 
_Max ©   (2005-06-29 12:38) [3]

спасибо


 
ferr ©   (2005-06-29 12:43) [4]

отменяется. порядок важен....


 
Kolan ©   (2005-06-29 12:47) [5]

var
 A1: array[0..100] of Integer;
 A2: array[0..100] of Integer;
 I: Integer;
 K: Integer;
 S1, S2: string;
 StartTick, EndTick: LongInt;
begin
 Randomize;
 for I := Low(A1) to High(A1) do
   A1[I] := Random(9);

 StartTick := GetTickCount;
 for I := Low(A2) to High(A2) do
   A2[I] :=0;

 K := Low(A2);
 for I := Low(A1) to High(A1) do
 begin
   if A1[I] <> 0 then
   begin
     A2[K] := A1[I];
     K := K + 1;
   end;
 end;
 EndTick := GetTickCount;
 {...}

 S1 := "";
 S2 := "";
 for I := Low(A1) to High(A1) do
 begin
   S1 := S1 + IntToStr(A1[I]);
   S2 := S2 + IntToStr(A2[I]);
 end;
 ShowMessage(S1 + #13+ S2 + #13 + "Время: " + IntToStr(EndTick - StartTick) + "мс.");

end;


 
Просто Джо ©   (2005-06-29 12:47) [6]


...
type
 TIntArray = array of Integer;
...
function ShiftZeroes (const Source: TIntArray): TIntArray;
var
 I,ZeroCnt: Integer;
begin
 SetLength (Result,Length(Source));
 FillChar(Result[0],Length(Source),0);
 ZeroCnt := 0;
 for I := Low(Source) to High(Source) do
 begin
   if Source[I] = 0 then
     Inc (ZeroCnt)
   else
     Result[I-ZeroCnt] := Source[I];
 end;
end;


Проверка:

procedure DumpArray (Arr: TIntArray);
var
 I: Integer;
begin
 for I := Low(Arr) to High(Arr) do
   Write (Arr[I]," ");
 WriteLn;
end;

var
 Source,
 Dest: TIntArray;
begin
 SetLength (Source,6);
 Source[0] := 1;
 Source[1] := 0;
 Source[2] := 3;
 Source[3] := 4;
 Source[4] := 0;
 Source[5] := 1;

 Dest := ShiftZeroes(Source);
 DumpArray(Dest);

 ReadLn;
end.


 
MBo ©   (2005-06-29 12:49) [7]


 Cnt := 0;
 for i := 0 to n - 1 do
   if a[i] = 0 then
     Inc(Cnt)
   else
     a[i - Cnt] := a[i];
 for i := n - Cnt to n - 1 do  //или FillChar, ZeroMemory
   a[i] := 0;


 
ferr ©   (2005-06-29 12:50) [8]

Расскажите про массив: длина, диапазон значений.


 
Просто Джо ©   (2005-06-29 12:52) [9]


>  [7] MBo ©   (29.06.05 12:49)

С опозданьицем ;^)


 
Просто Джо ©   (2005-06-29 13:34) [10]

Помимо [6] и аналогичных вариантов возможно стоит подумать о классе-обертке. Например таком (интенсивно не тестировал, не оптимизировал, стремился показать идею).


unit Arr;

interface
uses Classes;

type

 TIntArray = array of Integer;

 TZeroShiftedList = class
 private
   FList: TList;
   FZeroCount: Integer;
   procedure DumpList (var Arr: TIntArray);
 public
   // конструктор создает пустой массив
   constructor Create; overload;
   // этот вариант конструктора принимает на входе уже готовые значения
   constructor Create (Values: array of const); overload;
   destructor Destroy; override;
   // добавляет новое значение к массиву
   procedure AddValue (AValue: Integer);
   // этот метод возвращает упорядоченный массив
   function GetArray: TIntArray;
 end;

implementation

procedure TZeroShiftedList.AddValue(AValue: Integer);
begin
 if AValue = 0 then
   Inc (FZeroCount)
 else
   FList.Add(Pointer(AValue))
end;

constructor TZeroShiftedList.Create;
begin
 FList := TList.Create;
 FZeroCount := 0
end;

constructor TZeroShiftedList.Create(Values: array of const);
var
 I: Integer;
begin
 Create;
 for I := Low(Values) to High(Values) do
   AddValue(Values[I].VInteger);
end;

destructor TZeroShiftedList.Destroy;
begin
 FList.Free;
 inherited;
end;

procedure TZeroShiftedList.DumpList(var Arr: TIntArray);
var
 I: Integer;
begin
 for I := 0 to FList.Count-1 do
   Arr[I] := Integer(FList[I])
end;

function TZeroShiftedList.GetArray: TIntArray;
begin
 SetLength (Result,FZeroCount+FList.Count);
 if Length(Result)>0 then
 begin
   FillChar (Result[0],Length(Result),0);
   DumpList(Result);
 end;
end;

end.


Класс может быть полезен, если данные в массив постоянно добавляются в ходе программы, а извлекаются относительно редко.

========
Пример 1.

uses Arr;
...
procedure DumpArray (Arr: TIntArray);
var
I: Integer;
S: string;
begin
S := "";
for I := Low(Arr) to High(Arr) do
  S := S + " " + IntToStr(Arr[I]);
 ShowMessage(S);
end;

procedure TForm2.Button1Click(Sender: TObject);
var
 Lst: TZeroShiftedList;
 Arr: TIntArray;
begin
 // задаем уже готовые данные
 Lst := TZeroShiftedList.Create ([10,0,20,30,0,40]);
 try
   ...
   // добавляем еще несколько значений:
   Arr.AddValue(0);
   Arr.AddValue(22);
   ...
   Arr := Lst.GetArray;
   DumpArray(Arr);
 finally
   Lst.Free;
 end;

end;



Пример 2.

procedure TForm2.Button1Click(Sender: TObject);
var
 Lst: TZeroShiftedList;
 Arr: TIntArray;
begin
 // создаем пустым
 Lst := TZeroShiftedList.Create;
 try
   // добавляем еще несколько значений:
   Arr.AddValue(0);
   Arr.AddValue(22);
   Arr := Lst.GetArray;
   DumpArray(Arr);
 finally
   Lst.Free;
 end;

end;


У этого подхода можно найти и другие преимущества (надеюсь).



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

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

Наверх




Память: 0.5 MB
Время: 0.034 c
1-1120017441
Alex_K
2005-06-29 07:57
2005.07.18
Объявление переменной во время работы проги.


6-1113128131
Stalker01
2005-04-10 14:15
2005.07.18
Трафик при отправке почты


14-1119531872
kaif
2005-06-23 17:04
2005.07.18
Голосование: кто порождает СПАМ, заказчики или рассыльщики?


3-1117799125
Iova
2005-06-03 15:45
2005.07.18
Как получить список реквизитов справочника


4-1116683520
BoAlSe
2005-05-21 17:52
2005.07.18
Список всех видеорежимов...