Lưu ý: Các code mẫu dưới đây chỉ mang tính tham khảo và có thể không AC được bài tập này

Code mẫu của RR

{$R-,Q-}
uses math;
const
  FINP='';
  FOUT='';
  MAXN=222;
  oo=100000000;
var
  sum,fl,first,last,n:longint;
  typ,queue,deg,trace,dt,xet:array[1..MAXN] of longint;
  a,c,d:array[1..MAXN,1..MAXN] of longint;
procedure inp; inline;
var
  f:text;
  cc,i,u,v,k:longint;
begin
  assign(f,FINP); reset(f);
  read(f,n);
  read(f,k);
  for i:=1 to k do
    begin
      read(f,u); inc(u);
      inc(deg[u]); a[u,deg[u]]:=1;
      c[u,1]:=oo;
      typ[u]:=1;
    end;
  read(f,k);
  for i:=1 to k do
    begin
      read(f,u); inc(u);
      inc(deg[n+2]); a[n+2,deg[n+2]]:=u;
      typ[u]:=2;
      c[n+2,u]:=oo;
    end;
  read(f,k);
  for i:=1 to k do
    begin
      read(f,u,v,cc); inc(u); inc(v);
      if typ[u]+typ[v]=3 then continue;
      c[u,v]:=cc; c[v,u]:=c[u,v];
      inc(deg[u]); a[u,deg[u]]:=v;
      inc(deg[v]); a[v,deg[v]]:=u;
    end;
  sum:=0;
  for u:=2 to n+1 do
  for v:=u+1 to n+1 do
    sum:=sum+c[u,v];
  close(f);
end;
procedure ans; inline;
var
  f:text;
  count,i,j,v,cost:longint;
begin
  assign(f,FOUT); rewrite(f);
  count:=0; cost:=sum-fl;
  for i:=2 to n+1 do
    if trace[i]=0 then inc(count);
  writeln(f,cost,' ',count);
  for i:=2 to n+1 do
    if trace[i]=0 then write(f,i-1,' ');
  writeln(f);
  close(f);
end;
procedure init; inline;
begin
  fillchar(dt,sizeof(dt),0); dt[n+2]:=oo;
  fillchar(xet,sizeof(xet),0); xet[n+2]:=1;
  fillchar(trace,sizeof(trace),0); trace[n+2]:=n+2;
  first:=1; last:=1; queue[1]:=n+2;
end;
procedure findPath; inline;
var
  u,i,v:longint;
begin
  while first<=last do
    begin
      u:=queue[first]; inc(first);
      for i:=1 to deg[u] do
        begin
          v:=a[u,i];
          if xet[v]=0 then
            if (c[u,v]>0) and (c[u,v]>d[u,v]) then
              begin
                xet[v]:=1;
                trace[v]:=u;
                dt[v]:=min(dt[u],c[u,v]-d[u,v]);
                inc(last); queue[last]:=v;
              end
            else if (d[v,u]>0) then
              begin
                xet[v]:=1;
                trace[v]:=-u;
                dt[v]:=min(dt[u],d[u,v]);
                inc(last); queue[last]:=v;
              end;
        end;
      if xet[1]=1 then exit;
    end;
end;
procedure incFlow; inline;
var
  x,pre:longint;
begin
  x:=1;
  repeat
    pre:=trace[x];
    if pre>0 then d[pre,x]:=d[pre,x]+dt[1]
    else d[x,-pre]:=d[x,-pre]-dt[1];
    x:=abs(pre);
  until x=n+2;
end;
procedure solve; inline;
begin
  fl:=0;
  repeat
    init;
    findPath;
    if dt[1]>0 then incFlow;
    fl:=fl+dt[1];
  until dt[1]=0;
end;
begin
  inp;
  solve;
  ans;
end.