COIN34 – SPOJ

Đề bài: http://vn.spoj.com/problems/COIN34/

Thuật toán:

Code:

uses math;
const
  fi='';
  fo='';
  maxs=2*trunc(1e6);
  maxn=17;
var
  st,d : array[1..maxs] of longint;
  c : array[1..maxn*2] of longint;
  i,j,n,res,s1,s2,x,d1,c1,top : longint;
procedure enter;
  begin
    assign(input,fi);reset(input);
    assign(output,fo);rewrite(output);
    c[1] :=2; c[2] := 3; c[3] := 5;
    for i:=4 to 34 do
      c[i] := c[i-1]+c[i-2]+c[i-3];
  end;
procedure up1;
  begin
    //if c1=x then begin res := max(res,d1); exit; end;
    //if c1>x then exit;
    inc(top); st[top] := c1;
    d[top] := d1;
  end;
procedure try1( i : longint);
  var j : longint;
  begin
    for j:=0 to 1 do
      begin
        if j=1 then begin c1 := c1+c[i]; inc(d1) end;
        if i=s1 then up1 else try1(i+1);
        if j=1 then begin c1 := c1-c[i]; dec(d1) end;
      end;
  end;
procedure up2;
  var dau,cuoi,giua,xx : longint;
  begin
    if x=c1 then begin res := max(res,d1); exit; end;
    if c1>x then exit;
    xx := x-c1;
    dau:=1;cuoi:=top;
    giua:=(dau+cuoi) div 2;
    while (giua<>dau) and (giua<>cuoi) do
      begin
        if st[giua]>=xx then cuoi :=giua else dau := giua;
        giua :=(dau+cuoi) div 2;
      end;
    for giua := dau to cuoi do
      if st[giua]=xx then break;
    if st[giua]=xx then res := max(res,d1+d[giua]);
  end;
procedure try2( i :longint);
  var j : longint;
  begin
    for j:=1 downto 0 do
      begin
        if j=1 then begin c1 := c1+c[i]; inc(d1); end;
        if i=34 then up2 else try2(i+1);
        if j=1 then begin c1 := c1-c[i]; dec(d1); end;
      end;
  end;
procedure swap(var x,y : longint);
  var tg : longint;
  begin
    tg:=x;x:=y;y:=tg;
  end;
procedure qs1(l,r : longint);
  var i,j,x,y : longint;
  begin
    i :=l;j:=r;
    x:=st[(l+r) div 2];
    y:=d[(l+r) div 2];
    repeat
      while (x>st[i]) or((x=st[i]) and (d[i]>y)) do inc(i);
      while (x<st[j]) or((x=st[j]) and (d[j]<y)) do dec(j);
      if i<=j then
        begin
          swap(st[i],st[j]);
          swap(d[i],d[j]);
          inc(i);dec(j);
        end;
    until i>j;
    if i<r then qs1(i,r);
    if l<j then qs1(l,j);
  end;
procedure init;
  begin
    s1 := 20; s2 := 21;
    try1(1);
    qs1(1,top);
    //try2(21);
  end;
procedure process;
  var t,tt : longint;
  begin
    readln(t);
    for tt:=1 to t do
      begin
        res := -1;
        readln(x);
        d1 := 0; c1 := 0;
        try2(21);
        writeln('Case #',tt,': ',res);
      end;
  end;
begin
  enter;
  init;
  process;
end.

MYSTERY – SPOJ

Đề bài: http://vn.spoj.com/problems/MYSTERY/

Thuật toán:

  • (đang cập nhập)

Code:

const
    x=20122007;
type int64 = qword;
 
var
    n,i : longint;
    f : array[0..1000000] of longint;
    res : int64;
 
function getVal(a:longint):longint;
var
    p,q,i : longint;
    g : int64;
begin
    if a<=1000000 then exit(f[a])
    else
    begin
        p:=a mod 1000000;
        q:=a div 1000000;
        g:=f[p];
        for i:=1 to q do g:=(g*f[1000000]) mod x;
        exit(g);
    end;
end;
 
begin
    readln(n);
 
    f[0]:=1;
    for i:=1 to 1000000 do f[i]:=(f[i-1]*3) mod x;
 
    res:=1;
    if sqr(trunc(sqrt(n))) = n then
    begin
      for i:=1 to trunc(sqrt(n))-1 do
      if n mod i=0 then
      res:=(((res*(getVal(i)-1)) mod x)*(getVal(n div i)-1)) mod x;
 
      res:=(res*(getVal(trunc(sqrt(n)))-1)) mod x;
  end else
  begin
    for i:=1 to trunc(sqrt(n)) do
      if n mod i=0 then
        res:=(((res*(getVal(i)-1)) mod x)*(getVal(n div i)-1)) mod x;
  end;
 
    writeln(res);
end.

KDEL – SPOJ

Đề bài: http://vn.spoj.com/problems/KDEL/

Thuật toán: 

  • (đang cập nhập)

Code:

const fi='';
      fo='';
      maxn=700000;
var   i,j:longint;
      f:text;
      n,k,d:longint;
      tam:array[1..maxn] of boolean;
      ngto:array[1..50000] of longint;
      hold,res:ansistring;
procedure nhap;
begin
    assign(f,fi);reset(f);
    readln(f,n,k);
    close(f);
end;
procedure sang;
begin
    tam[1]:=true;
    for i:=2 to trunc(sqrt(maxn)) do
      if tam[i]=false then
        begin
             j:=i*i;
             while j<=maxn do
                   begin
                       tam[j]:=true;
                       j:=j+i;
                   end;
        end;
    d:=0;
    for i:=2 to maxn do
      if tam[i]=false then
         begin
             inc(d);
             ngto[d]:=i;
             if d=n then exit;
         end;
end;
procedure xuly;
var       tmp,tam:ansistring;
          le,leres:int64;
begin
    sang;
 
 
 
 
    for i:=1 to n do
      begin
          str(ngto[i],tmp);
          hold:=hold+tmp;
      end;
 
    le:=length(hold);
    leres:=le-k;
 
    for i:=1 to le do
      begin
          while (k>0) and (length(res)>0) and (res[length(res)]<hold[i]) do
                begin
                    delete(res,length(res),1);
                    dec(k);
                end;
          res:=res+hold[i];
      end;
 
    while length(res)>leres do
        begin
            delete(res,length(res),1);
        end;
 
 
end;
procedure xuat;
begin
    assign(f,fo);rewrite(f);
    writeln(f,res);
    close(f);
end;
begin
    nhap;
    xuly;
    xuat;
end.

DHSERV – SPOJ

Đề bài: http://vn.spoj.com/problems/DHSERV/

Thuật toán:

  • Bài này thuần sử dụng thuật toán Floyd. Các bạn có thể tham khảo code bên dưới để hiểu thêm.

Code:

const
  fi='';//hserv.inp';
  fo='';//dhserv.out';
  maxn=500;
  oo=trunc(1e18);
var
  a : array[1..maxn,1..maxn] of int64;
  d : array[1..maxn,1..maxn] of int64;
  i,j,n,m,k : longint;
procedure enter;
  var u,v,w : longint;
  begin
    assign(input,fi);reset(input);
    readln(n,m,k);
    for i:=1 to n do
      for j:=1 to n do
        if i<>j then
          begin
            d[i,j] := oo;
            a[i,j] := oo;
          end else
          begin
            d[i,j] := 0;
            a[i,j] := 0;
          end;
    for i:=1 to m do
      begin
        read(u,v,w);
        a[u,v] := w;
        d[u,v] := w;
      end;
  end;
procedure process;
  var tg,kieu,u,v,kk : longint;
  begin
    assign(output,fo);rewrite(output);
    for kk:=1 to k do
      begin
        read(kieu);
        if kieu=1 then
          begin
            read(tg);
            for u:=1 to n do
              for v:=1 to n do
                if d[u,v] > d[u,tg] + d[tg,v] then
                  begin
                    d[u,v] := d[u,tg] + d[tg,v];
                  end;
          end;
        if kieu=2 then
          begin
            read(u,v);
            if d[u,v]=oo then writeln(-1) else 
            writeln(d[u,v]);
          end;
      end;
      close(output);
  end;
begin
  enter;
  process;
end.

SPSEQ – SPOJ

Đề bài: http://vn.spoj.com/problems/SPSEQ/

Thuật toán:

  • Gọi f1[i] là độ dài dãy con không giảm dài nhất kết thúc là a[i] của dãy a[1..i]
  • Gọi f2[i] là độ dài dãy con không tăng dài nhất bắt đầu là a[i] của dãy a[i..n]
  • Kết quả bài toán là:
    <span class="nu0">2</span>*min<span class="br0">(</span>f1<span class="br0">[</span>i<span class="br0">]</span>,f2<span class="br0">[</span>i<span class="br0">]</span><span class="br0">)</span> -<span class="nu0">1   với i=1..n;</span>

Code:

uses    math;
const   fi='';
        fo='';
        maxn=trunc(1e5)+3;
        oo=trunc(1e9)+7;
var     a:array[0..maxn] of longint;
        b1,b2:array[0..maxn] of longint;
        f1,f2:array[0..maxn] of longint;
        i,j,n,m,res:longint;
procedure enter;
begin
        assign(input,fi);reset(input);
        readln(n);
        for i:=1 to n do read(a[i]);
        close(input);
end;
function tim1(r,x:longint):longint;
var     d,c,g:longint;
begin
        d:=0;c:=r;
        g:=(d+C) div 2;
        while (g<>d) and (g<>c) do
                begin
                        if b1[g]>=x then c:=g else d:=g;
                        g:=(d+c) div 2;
                end;
        for g:=c downto d do
                begin
                        if b1[g]<x then exit(g);
                end;
        exit(0);
end;
function tim2(r,x:longint):longint;
var     d,c,g:longint;
begin
        d:=0;c:=r;
        g:=(d+c) div 2;
        while (g<>d) and (g<>c) do
                begin
                        if b2[g]>=x then c:=g else d:=g;
                        g:=(d+c) div 2;
                end;
        for g:=c downto d do
                if b2[g]<x then exit(g);
        exit(0);
end;
procedure process;
var     tam1,tam2:longint;
        res1,res2:longint;
begin
        res1:=1;
        b1[0]:=-oo;
        b1[1]:=a[1];
        f1[1]:=1;
        for i:=2 to n do
                begin
 
                        tam1:=tim1(res1,a[i]);
                        if tam1+1>res1 then
                                begin
                                        inc(res1);
                                        b1[res1]:=a[i];
                                end else
                        if b1[tam1+1]>a[i] then b1[tam1+1]:=a[i];
                        f1[i]:=tam1+1;
                end;
        res2:=1;
        b2[0]:=-oo;
        f2[n]:=1;
        b2[1]:=a[n];
        for i:=n-1 downto 1 do
                begin
                        tam2:=tim2(res2,a[i]);
                        if tam2+1>res2 then
                                begin
                                        inc(res2);
                                        b2[res2]:=a[i];
                                end else
                                if b2[tam2+1]>a[i] then b2[tam2+1]:=a[i];
                        f2[i]:=tam2+1;
                end;
        res:=0;
        for i:=1 to n do
                res:=max( res, 2*min(f1[i],f2[i]) -1 );
end;
procedure print;
begin
        assign(output,fo);rewrite(Output);
        writeln(res);
        close(output);
end;
begin
        enter;
        process;
        print;
end.

Tổng hợp tài liệu về thuật toán Luồng

YeuLapTrinh.pw xin được tổng hợp lại các tài liệu về thuật toán Luồng:

 

  1. Tài liệu Luồng mới nhất của thầy Lê Minh Hoàng: http://yeulaptrinh.pw/wp-content/uploads/2016/07/Part6.pdf

NKFLOW – SPOJ

Đề bài: http://vn.spoj.com/problems/NKFLOW/

Thuật toán:

  • Bài này đơn thuần sử dụng thuật toán luồng. Bạn có thể tham khảo về thuật toán luồn tại:

Code:

{$MODE OBJFPC}
program MaximumFlow;
const
  InputFile  = '';
  OutputFile = '';
  maxN = Round(1E5);
  maxM = Round(1E5);
  maxC = Round(1E9);
type
  TEdge = record
    x, y: Integer;
    c, f: Integer;
    link, link2: Integer;
  end;
var
  fi, fo: TextFile;
  e: array[-maxM..maxM] of TEdge;
  head, head2: array[1..maxN] of Integer;
  level: array[1..maxN] of Integer;
  q: array[1..maxN] of Integer;
  front, rear: Integer;
  n, m, s, t: Integer;
  FlowValue: Int64;
 
procedure Enter;
var
  i: Integer;
  u, v, capacity: Integer;
begin
  ReadLn(fi, n, m, s, t);
  for i := 1 to m do
    begin
      ReadLn(fi, u, v, capacity);
      with e[i] do
        begin
          x := u; y := v; c := capacity;
        end;
      with e[-i] do
        begin
          x := v; y := u; c := 0;
        end;
    end;
end;
 
procedure BuildIncidentLists;
var
  i: Integer;
begin
  FillDWord(head[1], n, 0);
  FillDWord(head[2], n, 0);
  for i := -m to m do
    if i <> 0 then
      with e[i] do
        begin
          link := head[x]; head[x] := i;
          link2 := head2[y]; head2[y] := i;
        end;
end;
 
procedure InitZeroFlow;
var
  i: Integer;
begin
  for i := -m to m do e[i].f := 0;
  FlowValue := 0;
end;
 
function Min(x, y: Integer): Integer; inline;
begin
  if x < y then Result := x else Result := y;
end;
 
function cf(const e: TEdge): Integer; inline; //tinh du
begin
  with e do
    Result := c - f;
end;
 
procedure IncFlow(i: Integer; Delta: Integer); inline; //tang canh i len denta
begin
  Inc(e[i].f, Delta);
  Dec(e[-i].f, Delta);
end;
 
procedure BuildLevelGraph; //tinh t ve s
var
  u, v, i: Integer;
begin
  FillDWord(level[1], n, 0);
  level[t] := 1;
  q[1] := t;
  front := 1; rear := 1;
  repeat
    u := q[front]; Inc(front);
    i := head2[u];
    while i <> 0 do
      begin
        v := e[i].x; //ke
        if (cf(e[i]) > 0) and (level[v] = 0) then
          begin
            level[v] := level[u] + 1;
            if v = s then Exit;
            Inc(rear);
            q[rear] := v;
          end;
        i := e[i].link2;
      end;
  until front > rear;
end;
 
function Visit(u: Integer; Delta: Integer): Integer;      // tu s den t
var
  i, v: Integer;
  p, q: Integer;
begin
  if u = t then Exit(Delta);
  if level[u] = 0 then Exit(0);
  q := 0;
  i := head[u];
  while i <> 0 do
    begin
      if (cf(e[i]) > 0) and (level[e[i].y] = level[u] - 1) then
        begin
          v := e[i].y;
          p := Visit(v, Min(Delta, cf(e[i])));
          IncFlow(i, p);
          Inc(q, p);
          Dec(Delta, p);
          if Delta = 0 then Exit(q);
        end;
      i := e[i].link;
    end;
  Result := q;
end;
 
function AugmentFlow: Integer;
begin
  Result := Visit(s, maxC);
end;
 
procedure PrintResult;
var
  i: Integer;
begin
  WriteLn(fo, FlowValue);
end;
 
begin
  AssignFile(fi, InputFile); Reset(fi);
  AssignFile(fo, OutputFile); Rewrite(fo);
  try
    Enter;
    BuildIncidentLists;
    InitZeroFlow;
    repeat
      BuildLevelGraph;
      if level[s] = 0 then Break;
      Inc(FlowValue, AugmentFlow);
    until False;
    PrintResult;
  finally
    CloseFile(fi); CloseFile(fo);
  end;
end.