Определить, можно ли расплатиться за покупку без сдачи - Free Pascal

Формулировка задачи:

В Волшебной стране используются монетки достоинством A1, A2,…, AM. Волшебный человечек пришел в магазин и обнаружил, что у него есть ровно по две монетки каждого достоинства. Ему нужно заплатить сумму N. Напишите программу, определяющую, сможет ли он расплатиться без сдачи. Входные данные В первой строке записано сначала число N (1 ≤ N≤ 10^9), затем число M (1 ≤ M≤ 16). Во второй строке записано M попарно различных чисел A1, A2,…, AM (1 ≤ Ai ≤ 107). Числа разделяются пробелами. Выходные данные Выведите наименьшее количество монет K, которое придется отдать Волшебному человечку, если он сможет заплатить указанную сумму без сдачи. Если без сдачи не обойтись, то выведите одно число 0. Если же у Волшебного человечка не хватит денег, чтобы заплатить указанную сумму, выведите одно число –1 (минус один). Вот мой код, но он крашится
var
  a:array[0..100] of integer;
  n,sum,k,min,i,j,m:integer;
 
procedure prod;
var
  j:integer;
begin
  for j:=1 to 2 do begin
    if(i>m)then break;
    sum:=sum+j*a[i];
    inc(i);
  end;
  k:=k+j;
  if((sum=n))then  begin
    min:=k;
    exit;
  end;
  if(sum<n)then prod;
  sum:=sum-j*a[i];
  if(sum=n)then exit;
  i:=i-1;
  k:=k-(j);
 
end;
 
begin
  readln(n,m);
  for i:=1 to m do begin
    read(a[i]);
    sum:=sum+2*a[i];
  end;
  if(sum<n)then begin
    writeln(-1);
    exit;
  end
    else for i:=1 to m-1 do
      for j:=1 to m-1 do
        if a[j]<a[j+1] then begin
          k:=a[j];
          a[j]:=a[j+1];
          a[j+1]:=k;
        end;
  sum:=0;
  min:=maxint;
  k:=0;
  i:=1;
  prod;
  if(min<maxint)then writeln(min)
    else writeln(0);
  readln;
  readln;
end.
Помогите, пожалуйста

Код к задаче: «Определить, можно ли расплатиться за покупку без сдачи - Free Pascal»

textual
program Coins;
 
type
  TCoinsSet = array[1..16] of dword;
 
  function AmountCoins(N: dword; M: integer; const A: TCoinsSet): integer;
  var
    MinAmount, CurAmount: integer;
    Sum: dword;
 
    procedure Backtracking(NCoin: integer);
    var
      i: integer;
    begin
      if NCoin > M then
        Exit;
      if Sum > N then
        exit;
 
      for i := 0 to 2 do
      begin
        if Sum = N then
        begin
          if CurAmount < MinAmount then
            MinAmount := CurAmount;
        end;
        Backtracking(NCoin + 1);
        Inc(CurAmount);
        Sum := Sum + A[NCoin];
      end;
 
      Dec(CurAmount, 3);
      Sum := Sum - 3 * A[NCoin];
    end;
 
  begin
    MinAmount := M + M + 1;
    CurAmount := 0;
    Sum := 0;
    Backtracking(1);
    if MinAmount > M + M then
      MinAmount := 0;
    AmountCoins := MinAmount;
  end;
 
var
  N: dword;
  M: integer;
  A: TCoinsSet;
  Summ: Dword;
  i: integer;
begin
  Summ := 0;
 
  readln(N, M);
  for i := 1 to M do
  begin
    Read(A[i]);
    Summ := Summ + A[i];
  end;
  if Summ + Summ < N then
  begin
    writeln('-1');
  end
  else
  begin
    writeln(AmountCoins(N, M, A));
  end;
end.

11   голосов, оценка 3.909 из 5


СОХРАНИТЬ ССЫЛКУ