Đề 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.

Đề 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)]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.

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

Thuật toán:

• (đang cập nhập)

Code:

using namespace std;
#include
#define FOR(i, a, b) for (int i = a; i < b; i++)
#define FORE(i, a, b) for (int i = a; i <= b; i++)
#define FORD(i, a, b) for (int i = a; i >= b; i--)
const int MAXN = 5001;
const int INF = 1e9 + 7;

string f[5001][101];
int n;

string operator +(string a, string b)
{
    FORE(i, a.length(), b.length() - 1) a = '0' + a;
    FORE(i, b.length(), a.length() - 1) b = '0' + b;
    string c = a;
    int nho = 0;
    FORD(i, a.length() - 1, 0){
        int tmp = (a[i] - '0') + (b[i] - '0') + nho;
        c[i] = (tmp % 10 + '0');
        nho = tmp / 10;
    }
    if (nho) c = '1' + c;
    return c;
}

int main()
{
    ios::sync_with_stdio(false); cin.tie(0);
    cin >> n;
    //cout<<"wtf"<

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

Thuật toán:

• (đang cập nhập)

Code:

const   fi      ='';
        fo      ='';
        oo      =400;

var
        c       :Array[0..oo,0..oo] of char;
        l,h,dem:array[0..oo+1] of int64;
        m, n ,k   :longint;
        f       :array['A'..'E'] of int64;
        ans     :int64;
Function Calc(x,y,z:char):int64;
var     ans   :int64;
	i, j:longint;
begin
        fillchar(h, sizeof(h),0);
        fillchar(dem,sizeof(dem),0);
        fillchar(l,sizeof(l),0);
        ans:=0;
        for i:=1 to m do
                begin
                        for j:=1 to n do
                                begin
                                        if (c[i,j]=x) or (c[i,j]=y) or (c[i,j]=z) then begin
                                        l[j]:=j;
                                        h[j]:=h[j]+1;
                                        while h[l[j]-1]>h[j] do
                                                l[j]:=l[l[j]-1];
                                        dem[j]:=h[j]*(j-l[j]+1)+dem[l[j]-1];
                                        ans:=ans+dem[j];
                                        end
                                        else begin
                                                dem[j]:=0;
                                                l[j]:=0;
                                                h[j]:=0;
                                        end;

                                end;

                end;
        exit(ans);
end;

procedure run;
var     i, j, tg    :longint;
        s       :ansistring;
        x, y, z :char;
begin
        assign(input,fi);assign(output,fo);
        reset(input);rewrite(output);
        readln(m, n);
        ans:=0;
        for i:=1 to m do
                begin
                        readln(s);
                        for j:=1 to n do
                                c[i,j]:=s[j];
                end;
        for x:='A' to 'E' do
                f[x]:=Calc(x,x,x);
        for x:='A' to 'E' do
                for y:=succ(x) to 'E' do
                        for z:=succ(y) to 'E' do
                                ans:=ans+Calc(x,y,z)-Calc(x,x,y)-Calc(y,y,z)
                                        -Calc(z,z,x)
                                        +f[x]+f[y]+f[z];
        writeln(ans);
        close(input);close(output);

end;

begin
        run;
end.

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

Thuật toán:

• (đang cập nhập)

Code:

{$MODE OBJFPC}
Const
        fi      ='';
        fo      ='';
        maxn    =10000;
        maxm    =100000;
        maxw    =1000000000;

Type
        Arr1    =array[0..maxn] of longint;
        Arr2    =array[0..2*maxm] of longint;
        tHeap   =record
          val   :Arr1;
          pos   :Arr1;
          nheap :longint;
        end;

Var
        n,m,x   :longint;
        p       :Arr1;
        d       :Arr1;
        head    :arr1;
        link,adj:arr2;
        t       :arr2;
        heap    :theap;
        kq      :longint;
        best    :longint;
        dm      :longint;
        f       :text;

Procedure ae(u,v,w:longint);
begin
        inc(dm);
        adj[dm]:=v;
        t[dm]:=w;
        link[dm]:=head[u];
        head[u]:=dm;
end;

Procedure Nhap;
var
        i,u,v,w :longint;
begin
        assign(f,fi);
        reset(f);
        readln(f,n,x,m);
        dm:=0;
        best:=maxlongint;
        for i:=1 to n do head[i]:=0;
        for i:=1 to x do readln(f,p[i]);
        for i:=1 to m do
          begin
            readln(f,u,v,w);
            ae(u,v,w);
            ae(v,u,w);
          end;
        close(f);
end;

Procedure InitHeap(s:longint);inline;
var
        i       :longint;
begin
        With Heap do
          begin
            nheap:=1;
            for i:=1 to n do
              begin
                pos[i]:=0;
                d[i]:=maxw;
              end;
            val[1]:=s;
            pos[s]:=1;
            d[s]:=0;
          end;
end;

Function getmin:longint;inline;
var
        v       :longint;
        cha,con :longint;
begin
        With Heap do
          begin
            if nheap=0 then exit(0);
            GetMin:=val[1];
            v:=val[nheap];
            cha:=1;
            dec(nheap);
            repeat
              con:=2*cha;
              if (connheap) or (d[val[con]]>=d[v]) then break;
              val[cha]:=val[con];
              pos[val[con]]:=cha;
              cha:=con;
            until false;
            val[cha]:=v;
            pos[v]:=cha;
          end;
end;

Procedure Update(v:longint);inline;
var
        cha,con :longint;
begin
        With Heap do
          begin
            con:=pos[v];
            if con=0 then
              begin
                inc(nheap);
                con:=nheap;
              end;
            repeat
              cha:=con div 2;
              if (cha=0) or (d[val[cha]]<=d[v]) then break;
              val[con]:=val[cha];
              pos[val[cha]]:=con;
              con:=cha;
            until false;
            val[con]:=v;
            pos[v]:=con;
          end;
end;

Procedure Dijkstra(s:longint);
var
        i,u,v   :longint;
        ss      :longint;
begin
        InitHeap(s);
        repeat
          u:=getmin;
          if u=0 then break;
          i:=head[u];
          while i<>0 do
            begin
              v:=adj[i];
              if d[v]>d[u]+t[i] then
                begin
                  d[v]:=d[u]+t[i];
                  update(v);
                end;
              i:=link[i];
            end;
        until false;
        ss:=0;
        for i:=1 to x do
          if d[p[i]]=maxw then exit
            else ss:=ss+d[p[i]];
        if (sss)) then
          begin
            best:=ss;
            kq:=s;
          end;
end;

Procedure Sol;
var
        i       :longint;
begin
        For i:=1 to n do Dijkstra(i);
end;

Procedure Xuat;
begin
        assign(f,fo);
        rewrite(f);
        write(f,kq);
        close(f);
end;

begin
        Nhap;
        sol;
        xuat;
end.