Delphi. Определить два наибольших(хотя и ровных)произведения

[hotkep]

Определить два крупнейших (хотя бы и равных) произведения A[i]*A[i-1].
У меня есть только код к условию :
Определить наибольшее значение произведения A[i]*A[i-1].

program Project2;

{$APPTYPE CONSOLE}

uses
SysUtils;

type
Type_arr = array[1..10] of integer;

var
a : type_arr;
N : integer;
q,i : integer;

procedure FilledWithConstNumbers(var a: type_arr; var N : integer);
const
a_const : type_arr = (1, 2, 3, 6, 5, 6, 7, 8, 0, 3);
begin
a := a_const;
N := 10;
end;

procedure FilledWithRandomNumbers(var a: type_arr; var N : integer);
var
i : integer;
begin
randomize;
write('Quantity of elements (1..N) ? ');
readln(N);
for i := 1 to N do
a[i] := random(30);
end;

procedure FilledFromKeyboard(var a: type_arr; var N : integer);
var
i : integer;
begin
write('Quantity of elements (1..N) ? ');
readln(N);
for i := 1 to N do
begin
write('a[', i, '] = ');
read(a[i]);
end;
end;

function indx(const a: type_arr; N : integer): integer;
var
i : integer;
max : integer;
begin
max := 2;
for i := 2 to N do
if a[i]*a[i-1] > a[max]*a[max-1] then max := i;
indx := max;
end;

begin
writeln('How to fill array?');
writeln('1. As typed constants.');
writeln('2. Whith random numbers.');
writeln('3. From keyboard.');
write('Enter the number of variant:');
readln(q);

case q of
1: FilledWithConstNumbers(a,N);
2: FilledWithRandomNumbers(a,N);
3: FilledFromKeyboard(a,N);
end;

if q <> 3 then
for i := 1 to N do
writeln('a[', i, '] = ', a[i]);

writeln('Number of element that has the greatest value of multiplying a[i]*a[1-i] is ', indx(a, N));

readln;
readln;

end.

................................... ..........
Здесь нужно просто подправить програмку. А как не пойму.
Заранее спасибо!



___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

[viron]

Определить наибольшее значение произведения A[i]*A[i-1]

А в этой программе идет поиск индекса, когда это произведение максимально.

[hotkep]

Я вас не понял...

[Serge_Bliznykov]

hotkep
подобную задачу можно решить разными способами..

на поверхности я вижу следующие два способа.
Способ 1). Сделать всё за один проход, но завести ещё одну переменную (например, max2) и в условии проверки/запоминания результатов учитывать, что если текущее произведение не больше, чем произведение A[max]*A[max-1], то проверять, не большее ли это произведение, чем A[max2]*A[max2-1] (при условии, что max2<>max)

Способ 2) ещё проще. Первый проход. находите максимальное произведение (его индекс). Второй проход по массиву. Тот же самый поиск, только при поиске элемент i=max - ПРОПУСКАЕТЕ.
Второй способ удобно реализовать в виде функции/процедуры, куда передавать индекс уже найденного ранее максимального произведения. При поиске первого максимума в качестве такого индекса можно передать заведомо несущестующий индекс (например, -1). При поиске второго - передавать индекс первого максимума.

[hotkep]

Спасибо Вам за ответ, но можете мне сам код написать с комментариями?

[Mad_Cat]

можно еще 2 мерный массив завести в 1 строке хранить произведения во второй индексы потом отсортировать столбцы по 1 строке по убыванию и забрать первые 2 значения строки #2

[Serge_Bliznykov]

Спасибо Вам за ответ, но можете мне сам код написать с комментариями?

А что там комментировать то?!
Надеюсь приведённый Вами код Вы сами писали? (ну или хотя бы понимаете, что он делает?!)

тогда всё просто:

....
function indx(const a: type_arr; N : integer; PrevMaxIndex : integer): integer;
var
  i : integer;
  max : integer;
begin
  if PrevMaxIndex = 2 
       then max := 3
     else max := 2;
  for i := 2 to N do
     if i<>PrevMaxIndex then
        if a[i]*a[i-1] > a[max]*a[max-1] then max := i;
  indx := max;
end;

....
var Max1 : integer;
....

Max1 := indx(a, N, -1);
writeln('Index of element that has the greatest value of multiplying a[i]*a[1-i] is ', Max1);

writeln('Index of element that has the NEXT greatest value of multiplying a[i]*a[1-i] is ', indx(a, N, Max1) );
...

p.s. свой код я не проверял, но думаю, что крупных ошибок я не допустил. Ну, если что - подправить можно. Будем считать это домашним заданием...