Задачка на массив Опции

[kent]

Есть такая задача:
Дано вещественное число R и массив размера N. Найти два элемента массива, сумма которых наиболее|наименее близка к данному числу.
Подскажите как решать, а то я даже не знаю как начать...

Сообщение отредактировано: kent - 12.07.2005 18:37

[mlc]

Есть такая задача:

Подскажите как решать, а то я даже не знаю как начать... 

Перебираешь все пары элементов, находишь разницу (R- сумма) по модулю, запоминаещь индексы обоих если ок. Все просто.

Ps 2 Volvo: как скажешь

[kent]

Перебираешь все пары элементов, находишь разницу (R- сумма) по модулю, запоминаещь индексы обоих если ок.

Я все понял, в принципе я так и хотел делать, только вот единственное как перебрать элементы каждый с каждым (это ведь сколько комбинаций) да и ещё чтоб индексы запомнить, честно говоря как это все на практике выглядит не знаю, может пример покажет кто-нибудь...

Сообщение отредактировано: kent - 12.07.2005 23:14

[volvo]

Вот тут есть хорошее объяснение алгоритма генерации сочетаний (в присоединенном документе). Для твоего примера будет N оно и есть N, но M = 2, то есть будут генерироваться индексы всех возможных сочетании по 2 элемента из N: Генерация всех перестановок элементов

[kent]

volvo, спасибо за ссылку... :thanks:
Вот вроде решил: :p1:

Program Array18;
{Дано вещественное число R и массив размера N. Найти два элемента массива,
сумма которых наиболее|наименее близка к данному числа.}
uses crt;
var a:array [1..1000] of Integer;
    sum:array [1..1000] of Real;
    buf:array [1..1000] of Real;
    dif:array [1..1000] of Real;
    id_1:array [1..1000] of Integer;
    id_2:array [1..1000] of Integer;
    N,i,m,j:Integer;
    k,all:Integer;
    r:Real;
    min,max:Real;
    min_id,max_id:Integer;
    short_sum_a_1,short_sum_a_2:Integer;
    long_sum_a_1,long_sum_a_2:Integer;
begin
     Clrscr;
     min:=maxint; max:=-maxint;
     Write('Введите вещественное число R:');
     ReadLn®;
     Write('Введите целое число N:');
     ReadLn(N);
     Write('Введите массив размера N:');
     for i:=1 to N do begin
         Read(a[i]);
         buf[i]:=a[i];
     end;
     m:=2;
     for i:=1 to m do a[i]:=i;
     k:=0;
     repeat
     k:=k+1;
     for i:=1 to m do begin
        if (i>1) then begin
          id_1[k]:=a[i-1];
          id_2[k]:=a[i];
        end;
     end;
     sum[k]:=buf[(id_1[k])]+buf[(id_2[k])];
     i:=m;
     while a[i]=N-m+i do dec(i);
     inc(a[i]);
     for j:=i+1 to m do a[j]:=a[j-1]+1;
     until i=0;
     all:=k;
     for k:=1 to all do begin
        if ((sum[k]>0) and (r>0)) or ((sum[k]<0) and (r<0)) then
           dif[k]:=abs(sum[k]-r)
         else if ((sum[k]>0) and (r<0)) or ((sum[k]<0) and (r>0)) then
           dif[k]:=abs(sum[k]+r);
         if (dif[k]<min) then begin
            min:=dif[k];
            min_id:=k;
         end;
         if (dif[k]>max) then begin
            max:=dif[k];
            max_id:=k;
         end;
     end;
     short_sum_a_1:=id_1[min_id]; short_sum_a_2:=id_2[min_id];
     long_sum_a_1:=id_1[max_id]; long_sum_a_2:=id_2[max_id];
     WriteLn('Наиболее приближенные:',short_sum_a_1,' ',short_sum_a_2);
     WriteLn('Наиболее удаленные:',long_sum_a_1,' ',long_sum_a_2);
     Readkey;
end.

Только у меня в TP 7.0 после вывода результата выдает еще какую то лабуду похожую на нотный знак...???

Сообщение отредактировано: kent - 13.07.2005 17:40

[volvo]

Ай-яй-яй... Нехорошо компилировать программы без ключа {$R+}
Попробуй поставить его в 1-ю строку программы, и ты увидишь, что в строке

while a[i]=N-m+i do dec(i);

происходит выход за пределы массива (Range-Check Error)... А это значит, что ни на что больше полагаться нельзя... Любые данные могут оказаться запорченными...

[Romtek]

Выход за пределы нужно всегда проверять!
смотрим код:

     repeat

         k:=k+1;
         for i:=1 to m do begin
            if (i>1) then begin
              write (k:4); { вставил здесь для отладки, потому что был выход за пределы. Индекс K был 1001 ...}

              id_1[k]:=a[i-1];
              id_2[k]:=a[i];
            end;
         end;

Т.е. нужно добавить проверку (K<=1000)

Далее...

while a[i]=N-m+i do dec(i);

Где проверка (i > 1) ?
Должно быть так:

while (i>1) and (a[i]=N-m+i) do dec(i);

[Romtek]

Проверку на K нужно добавлять на строке until:

until (i=0) or (k = 1000);

[kent]

Ай-яй-яй... Нехорошо компилировать программы без ключа {$R+}

А что это за ключ и для чего он нужен?

[kent]

Romtek, поставил проверку как ты сказал, вроде больше этот знак не вылезает...
Спасибо что поправил!

[Romtek]

Нужен для проверки выхода за пределы границ массива. Тогда программа прервётся с ошибкой 201.

Можно выставить в опциях IDE: Options -> Compiler -> [X] Range checking
И сохранить установки.

Сообщение отредактировано: Romtek - 13.07.2005 17:18

[kent]

Теперь понял...
Еще раз спасибо всем кто помогал. :thanks: