Комбинаторика (исправить ошибку) / Pascal ABC

const m=9;
      c:array[1..m] of integer=(1,2,5,10,20,50,100,200,500);
 
      m2=2*m;
 
type  TTerm=array[1..m2] of integer;
      PTermList=^TTermList;
      TTermList=record
        u,v:TTerm;
        next:PTermList;
      end;
 
var   Basis:TTermList;
      p,q,r,t:PTermList;
      i,j,k:integer;
 
function cmp(var x,y:TTerm):integer;
var t,i,dx,dy:integer;
begin
  dx:=0; dy:=0; t:=0;
  for i:=1 to m2 do
  begin
    inc(dx,x[i]); inc(dy,y[i]);
    if t=0 then
    begin
      if x[i]>y[i] then t:=1;
      if y[i]>x[i] then t:=-1;
    end;
  end;
  if dx=dy then cmp:=t else if dx>dy then cmp:=1 else cmp:=-1;
end;
 
function S(var a,b,c:PTermList):boolean;
var x,y:TTerm;
    i,t:integer;
begin
  S:=False;
  for i:=1 to m2 do
  begin
    if a^.u[i]>b^.u[i] then t:=a^.u[i] else t:=b^.u[i];
    x[i]:=t-a^.u[i]+a^.v[i]; y[i]:=t-b^.u[i]+b^.v[i];
    if x[i]>y[i] then t:=y[i] else t:=x[i];
    dec(x[i],t); dec(y[i],t);
  end;
  case cmp(x,y) of
   1: begin c^.u:=x; c^.v:=y; end;
  -1: begin c^.u:=y; c^.v:=x; end;
  else S:=True; 
  end;
end;
 
function Reduce(var a:PTermList):boolean;
var p:PTermList;
    x:TTerm;
    i:integer;
begin
  p:=Basis.next;
  repeat
  if a<>p then
  begin
    i:=1; while (i<=m2) and (a^.u[i]>=p^.u[i]) do inc(i);
    if i>m2 then
    begin
      if S(a,p,a) then begin Reduce:=true; exit; end;
      p:=@Basis;
    end;
  end;
  p:=p^.next;
  until (p=nil);
  Reduce:=false;
end;
 
procedure ReduceBasis;
var p,q,t:PTermList;
begin
  p:=@Basis;
  repeat
    q:=p; p:=p^.next;
    while (p<>nil) and Reduce(p) do
    begin
      q^.next:=p^.next; dispose(p); p:=q^.next;
    end;
    if p=nil then break;
    t:=p;
    while (t^.next<>nil) and (cmp(t^.next^.u,p^.u)=1) do t:=t^.next;
    if t<>p then
    begin
      q^.next:=p^.next; p^.next:=t^.next; t^.next:=p;
    end;
    p:=q^.next;
  until p=nil;
end;
 
begin
  Basis.next:=nil;
  for i:=1 to m do
  begin
    if i>1 then
    begin
      new(p); with p^ do
      begin
        FillChar(u,SizeOf(u),0); u[1]:=c[i];
        FillChar(v,SizeOf(v),0); v[i]:=1;
        next:=Basis.next;
      end;
      Basis.next:=p;
    end;
    new(p); with p^ do
    begin
      FillChar(u,SizeOf(u),0); u[1]:=c[i]; u[m+i]:=1;
      FillChar(v,SizeOf(v),0);
      next:=Basis.next;
    end;
    Basis.next:=p;
  end;
 
  write('Construct Groebner basis');
  p:=@Basis; new(r);
  repeat
    q:=p^.next;
    while (q<>nil) do
    begin
      if (not S(p,q,r)) and (not Reduce(r)) then
      begin
        t:=@Basis;
        while (t^.next<>nil) and (cmp(t^.next^.u,r^.u)=1) do t:=t^.next;
        r^.next:=t^.next; t^.next:=r; new(r);
        write('.');
        ReduceBasis;
        p:=@Basis; break;
      end;
      q:=q^.next;
    end;
    p:=p^.next;
  until p=nil;
  writeln(' Done');
 
  with r^ do
  repeat
    FillChar(u,SizeOf(u),0); FillChar(v,SizeOf(v),0);
    write('Amount of money (0 - exit): '); readln(u[1]);
    if u[1]=0 then break;    
    Reduce(r);
    write('Coins: ');
    j:=0;
    for i:=1 to m2 do
    begin
      for k:=1 to u[i] do
        if i<=m then write('+',c[i]) else write('-',c[i-m]);
      inc(j,u[i]);
    end;
    writeln; writeln('Total number: ',j);
  until false; 
  
  dispose(r);
  p:=Basis.next;
  while p<>nil do
  begin
    q:=p; p:=p^.next; dispose(q);  end;end.

const m=9;
      c:array[1..m] of integer=(1,2,5,10,20,50,100,200,500);
const K=1000;
var
   a:array[0..K] of integer;
   i,n,j:integer;
begin
 readln(n); 
 for i:=1 to K do 
 a[i]:=200000;
 for i:=0 to K  do 
 for j:=1 to m do 
 if (i+c[j]<=K) and (a[i+c[j]]>a[i]+1) then
 a[i+c[j]]:=a[i]+1;
 for i:=K downto 1  do 
 for j:=1 to m do
 if (i-c[j]>=0) and (a[i-c[j]]>a[i]+1) then
 a[i-c[j]]:=a[i]+1;
 writeln(a[n]);
 readln;
end.