突然发现我是Pascal第一个A的家伙 哈哈哈哈哈..

这道题解法就是置换的循环分解后欧几里得.

代码丑 求轻喷

program poj3708;

const maxn=217;

type bit=array[0..500] of longint;

var d,i,j:longint;
    n,m,t:bit;
    pa,pb,rb,pob,ra,poa,ca,cb:array[0..maxn] of longint;
    a,b:array[0..maxn] of int64;

function rep(i,n:int64):int64;
begin
exit((i mod n+n) mod n);
end;

procedure exgcd(var d,x,y:int64;i,j:int64);
var z:int64;
begin
if j=0 then begin
        d:=i; x:=1; y:=0;
end else begin
        exgcd(d,x,y,j,i mod j);
        z:=x-(i div j)*y;
        x:=y;
        y:=z;
end;
end;

function max(a,b:int64):int64;    begin
if a>b then exit(a) else exit(b); end;

procedure cvr(a:bit;d:longint);
var i,j:longint;
begin
fillchar(t,sizeof(t),0);
while a[0]>0 do begin
        inc(t[0]);
        for i:=a[0] downto 2 do begin
                inc(a[i-1],a[i] mod d * 100);
                a[i]:=a[i] div d;
        end;
        t[t[0]]:=a[1] mod d; a[1]:=a[1] div d;
        while (a[0]>0)and(a[a[0]]=0) do dec(a[0]);
end;
end;

procedure scan(var n:bit);
var i,j:longint;
    ch:char;
begin
fillchar(n,sizeof(n),0);
while not seekeoln do begin
        inc(n[0]);
        read(ch); n[n[0]]:=ord(ch)-48;
end; readln;
for i:=1 to n[0]>>1 do begin
        j:=n[i]; n[i]:=n[n[0]+1-i]; n[n[0]+1-i]:=j;
end;
for i:=1 to n[0]>>1+(n[0] and 1) do n[i]:=n[i<<1-1]+n[i<<1]*10;
n[0]:=n[0]>>1+(n[0] and 1);
cvr(n,d); n:=t;
end;

function buildequ:boolean;
var i,j,k:longint;
begin
if ca[m[m[0]]]<>ca[n[n[0]]] then exit(false);
a[1]:=ra[m[m[0]]];
b[1]:=rep(poa[n[n[0]]]-poa[m[m[0]]],a[1]);
for i:=2 to m[0] do begin
        if cb[m[m[0]+1-i]]<>cb[n[n[0]+1-i]] then exit(false);
        a[i]:=rb[m[m[0]+1-i]];
        b[i]:=rep(pob[n[n[0]+1-i]]-pob[m[m[0]+1-i]],a[i]);
end;
exit(true);
end;

function init:boolean;
var i,j,k,col:longint;
    flag:boolean;
begin
fillchar(pa,sizeof(pa),0); fillchar(pb,sizeof(pb),0);
fillchar(ra,sizeof(ra),0); fillchar(rb,sizeof(rb),0);
fillchar(ca,sizeof(ca),0); fillchar(cb,sizeof(cb),0);

readln(d); if d=-1 then begin
        halt;
end;
for i:=1 to d-1 do read(pa[i]); col:=0;
for i:=1 to d-1 do if ra[i]=0 then begin
        j:=i; k:=0; inc(col);
        repeat
                inc(k); poa[j]:=k; ca[j]:=col; j:=pa[j];
        until j=i;
        repeat
                ra[j]:=k; j:=pa[j];
        until j=i;
end;
for i:=0 to d-1 do read(pb[i]); col:=0;
for i:=0 to d-1 do if rb[i]=0 then begin
        j:=i; k:=0; inc(col);
        repeat
                inc(k); pob[j]:=k; cb[j]:=col; j:=pb[j];
        until j=i;
        repeat
                rb[j]:=k; j:=pb[j];
        until j=i;
end;
readln;

scan(m); scan(n); m[0]:=max(m[0],n[0]); n[0]:=m[0];
flag:=false; for i:=1 to n[0] do if m[i]<>n[i] then begin
        flag:=true;
        break;
end;
if not flag then begin
        writeln(0);
        exit(false);
end;
if buildequ then exit(true);
writeln('NO'); exit(false);
end;

function modsys(k:longint):int64;
var i,j:longint;
    tb,ta,d,x,y:int64;
begin
tb:=b[1]; ta:=a[1];
for i:=2 to k do begin
        exgcd(d,x,y,a[i],ta);
        if (tb-b[i]) mod d <> 0 then exit(-1);
        ta:=ta div d * a[i];
        tb:=rep((((tb-b[i]) div d)*x mod ta)*a[i]+b[i],ta);
end;
exit(tb);
end;

procedure work;
var i:int64;
begin
i:=modsys(m[0]);
if i=-1 then writeln('NO')
        else writeln(i);
end;

begin
while not seekeof do
        if init then work;
end.

• Re:附一组数据 (677) mrsimon 2014-04-06 19:08:02
  • Re:附一组数据 (20) Hoblovski 2014-04-06 20:29:36