Ошибка в алгоритме нахождения тройки чисел с максимальным произведением

[k1r1ch]

Вот вроде простая задача:
Дан массив чисел, надо выделить 3 числа с наибольшим произведением (числа целые и любого знака). Например: 1 2 -100 -30 -90 50. Оно бы написало -90 -100 50. Вот что я сделал:

program MaxTrio;
uses CRT;
var
  Arr: array [1..107] of integer;
  Res: array [1..3] of integer;
  Num, i, j, k, Temp: integer;
  Mul: longint;
begin
  ClrScr;
  j := 0;
  Mul := -10000;
  Write('How many numbers: ');         {Vvod chisel}
  Readln(Num);
  for i := 1 to Num do
    begin
    Write('Write number and press <Enter> (');
    Write(Num - i + 1);
    Write(' more): ');
    Readln(Arr[i]);
    end;
  for i := 1 to Num do
    for j := 1 to Num do
      for k := 1 to Num do
        begin
        if (i = j) or (i = k) or (j = k) then Temp := 0 else
          Temp := Arr[i] * Arr[j] * Arr[k];
        if Temp >= Mul then
          begin
          Mul := Temp;
          Res[1] := Arr[i];
          Res[2] := Arr[j];
          Res[3] := Arr[k];
          end;
        end;
  Write('Maximum trio is: '); {Vivod otveta}
  Write(Res[1]); Write(', ');
  Write(Res[2]); Write(', ');
  Writeln(Res[3]);
  repeat until keypressed;
end.

Но почему-то на некоторых числах ошибается, а работаю я в Паскале (Delphi под рукой нету), я ваще не понимаю отладку в нем (где там красные точечки ставить ). Вот например на уже упомянутую запись он выдаст 50 -30 -100, а на некоторых более сложные правильно делает. Почему?

[k1r1ch]

В общем я отключил здравый смысл и сделал так (но работает!):

program MaxTrio;
uses CRT;
var
  Arr, ArrAbs: array [1..107] of integer;
  Num, i, j: integer;

procedure Swap(var X, Y: integer);
var T: integer;
begin
  T := X;
  X := Y;
  Y := T;
end;

procedure SortUp;
begin
  for i := 1 to Num - 1 do
    for j := 1 to Num - i do
      if Arr[j] > Arr[j+1] then
        Swap(Arr[j], Arr[j+1]);
end;

procedure SortUpAbs;
begin
  for i := 1 to Num - 1 do
    for j := 1 to Num - i do
      if Abs(ArrAbs[j]) > Abs(ArrAbs[j+1]) then
        Swap(ArrAbs[j], ArrAbs[j+1]);
end;

begin
  ClrScr;
  j := 0;
  Write('How many numbers: ');         {Vvod chisel}
  Readln(Num);
  for i := 1 to Num do
    begin
    Write('Write number and press <Enter> (');
    Write(Num - i + 1);
    Write(' more): ');
    Readln(Arr[i]);
    end;
  ArrAbs := Arr;
  SortUpAbs; {Sortirovka s pomoshyu metoda puzirka}
  j := 0;
  for i := Num downto Num - 2 do
    if ArrAbs[i] < 0 then inc(j);
  case j of
    0,1: SortUp;
    2: Arr := ArrAbs;
    3: begin
       Arr[Num-1] := ArrAbs[Num];
       Arr[Num-2] := ArrAbs[Num-1];
       end;
  end;
  Write('Maximum trio is: ');     {Vivod otveta}
  Write(Arr[Num]); Write(', ');
  Write(Arr[Num-1]); Write(', ');
  Writeln(Arr[Num-2]);
  repeat until keypressed;
end.

Но все таки подскажите, если не затруднит, в чем была ошибка того алгоритма?

[LeBron]

Странно, но у меня все работает, и ошибки я не вижу. Ответы совпадают с простенькими тестами к этой задаче.
З.Ы. Ваше решение далеко не самое оптимальное. Ее можно делать линейно (и за секунду будет ответ для 2-3 миллионов чисел), а вы решаете лобовым методом за куб (и за секунду можно решить для 100-200 чисел), разницу видите?
З.З.Ы. И все таки Ваше решение неверное. Правда ошибка в другом и на многих тестах это не отобразится.

  if (i = j) or (i = k) or (j = k) then Temp := 0 else
          Temp := Arr[i] * Arr[j] * Arr[k]

при отсутствии в массиве неортицательных елементов у Вас будет получатся 0, вместо отрицательного числа.

[k1r1ch]

Сообщение от LeBron

И все таки Ваше решение неверное. Правда ошибка в другом и на многих тестах это не отобразится.

  if (i = j) or (i = k) or (j = k) then Temp := 0 else
          Temp := Arr[i] * Arr[j] * Arr[k]

при отсутствии в массиве неортицательных елементов у Вас будет получатся 0, вместо отрицательного числа.

Можно поподробнее, я что-то не понял, в чем ошибка то?

Сообщение от LeBron

Ваше решение далеко не самое оптимальное

А второе быстрее?

[LeBron]

Пример: массив -1 -2 -3. В нем единственное произведение равно -1*(-2)*(-3), тоесть -6. При (i = j) or (i = k) or (j = k) Вы присваиваете темпу 0, это не меньше мула, поэтому происходит присваивание значений произведения и 1ого, 2ого, 3его чисел ответа. Как результат - бред. Конкретно в моем тесте произведение будет в памяти хранится, как 0, а на выходе будет -3 -3 -3.

Второе решение немного быстрее, квадрат вместо куба, если в первом случае за секунду решалось для 100-300 чисел, то сдесь текущая реализация прокатит, в зависимости от мощности системы, для 2-5 тысяч. Оптимальное решение работает для нескольких миллионов (давно не мерил скорость считывания в паскале, она сильно затормозит тот солюшн, при уже готовом массиве в памяти - гарантировано укладывается в секунду для 20 миллионов чисел).

[LeBron]

И все равно неверно, причем довольно сильно бросаются в глаза недоработки. Вот, придумал тест-завалитель:
6
-1
10
10
-1111
-1111
-1111
Тоесть 6 чисел, которые начинаются после числа 6 Выводит:
Maximum trio is: -1111, -1111, -1111

[profi]

Пробуйте. Только, что набросал.

uses crt;
var
 a:array[1..10] of integer;
 i,max,min,maxi,mini,max_1,min_1:integer;
begin clrscr;

{for i:=1 to 10 do
    a[i]:=random(10)-2;
for i:=1 to 10 do
    write('a[',i,']=',a[i],' ');}

a[1]:=1; a[2]:=2; a[3]:=-100; a[4]:=-30; a[5]:=-90; a[6]:=50;

max:=0;
min:=0;
for i:=1 to 10 do
begin
    if a[i]>max then
    begin
       max:=a[i];
       maxi:=i;
    end;
    if a[i]<min then
    begin
       min:=a[i];
       mini:=i;
    end;
    end;

max_1:=0;
min_1:=0;
for i:=1 to 10 do
    if (i=maxi)or(i=mini) then
       continue
       else
       begin
            if a[i]>max_1 then
              max_1:=a[i];
            if a[i]<min_1 then
              min_1:=a[i];
       end;

writeln;
write(max,' ',min,' ');
    if abs(min_1)>abs(max_1) then
       begin
           if (min_1<>min) then
           write(min_1);
       end
       else
    if (max_1<>max) then
       write(max_1);
end.

[profi]

[удалил сам]