Arithmetic Progressions
USER: C Gang [cgangee1] TASK: ariprog LANG: PASCAL Compiling... Compile: OK Executing... Test 1: TEST OK [0.000 secs, 1876 KB] Test 2: TEST OK [0.000 secs, 1876 KB] Test 3: TEST OK [0.011 secs, 1876 KB] Test 4: TEST OK [0.000 secs, 1876 KB] Test 5: TEST OK [0.011 secs, 1940 KB] Test 6: TEST OK [0.162 secs, 2164 KB] Test 7: TEST OK [2.020 secs, 3124 KB] Test 8: TEST OK [4.709 secs, 3828 KB] Test 9: TEST OK [4.676 secs, 3828 KB]
{
ID:cgangee1
LANG:PASCAL
TASK:ariprog
}
type node=^nd;
nd=record nam:longint; next:node; end;
var i,j,k,m,n,l:longint;
p,q,b:longint;
v:array[0..250*250*2]of boolean;
list:array[0..100000]of longint;
flag,mark:boolean;
ans:array[1..250*250*2]of node;
h,e:node;
begin
mark:=true;
assign(input,'ariprog.in');reset(input);
assign(output,'ariprog.out');rewrite(output);
fillchar(v,sizeof(v),false);
fillchar(list,sizeof(list),0);
readln(n);
readln(m);
for i:=1 to m*m*2 do
begin
new(ans[i]);
ans[i]^.next:=nil;
end;
for p:=0 to m do
for q:=0 to m do
v[p*p+q*q]:=true;
for i:=0 to m*m*2 do
if v[i] then
begin
inc(list[0]);
list[list[0]]:=i;
end;
for i:=1 to list[0]-n+1 do
for j:=i+1 to list[0]-n+2 do
begin
flag:=true;
b:=list[j]-list[i];
k:=list[i]+b*(n-1);
if k>list[list[0]] then continue;
for l:=n downto 1 do
begin
if not(v[k]) then
begin
flag:=false;
break;
end;
dec(k,b);
end;
if flag then
begin
e:=ans[b];
while e^.next<>nil do e:=e^.next;
mark:=false;
new(h);
h^.nam:=list[i];
h^.next:=nil;
e^.next:=h;
end;
end;
for i:=1 to m*m*2 do
begin
h:=ans[i]^.next;
while h<>nil do
begin
writeln(h^.nam,' ',i);
h:=h^.next;
end;
end;
if mark then writeln('NONE');
close(input); close(output);
end.
========================================= 性感的分割线 =========================================
Mother’s Milk
USER: C Gang [cgangee1] TASK: milk3 LANG: PASCAL Compiling... Compile: OK Executing... Test 1: TEST OK [0.000 secs, 852 KB] Test 2: TEST OK [0.011 secs, 852 KB] Test 3: TEST OK [0.000 secs, 852 KB] Test 4: TEST OK [0.000 secs, 852 KB] Test 5: TEST OK [0.000 secs, 852 KB] Test 6: TEST OK [0.000 secs, 852 KB] Test 7: TEST OK [0.000 secs, 852 KB] Test 8: TEST OK [0.000 secs, 852 KB] Test 9: TEST OK [0.000 secs, 852 KB] Test 10: TEST OK [0.000 secs, 852 KB]
{
ID:cgangee1
LANG:PASCAL
TASK:milk3
}
program milk3;
var i,j,k,m,n,l:longint;
v:array[0..20,0..20,0..20]of boolean;
ans:array[0..20]of boolean;
va,vb,vc:longint;
flag:boolean;
function min(i,j:longint):longint;
begin
if i<j then exit(i);
exit(j);
end;
procedure dfs(a,b,c:longint);
var i,j,k:longint;
begin
v[a,b,c]:=true;
if a=0 then ans[c]:=true;
k:=min(a,vb-b);
if not(v[a-k,b+k,c]) then dfs(a-k,b+k,c);
k:=min(a,vc-c);
if not(v[a-k,b,c+k]) then dfs(a-k,b,c+k);
k:=min(b,va-a);
if not(v[a+k,b-k,c]) then dfs(a+k,b-k,c);
k:=min(b,vc-c);
if not(v[a,b-k,c+k]) then dfs(a,b-k,c+k);
k:=min(c,va-a);
if not(v[a+k,b,c-k]) then dfs(a+k,b,c-k);
k:=min(c,vb-b);
if not(v[a,b+k,c-k]) then dfs(a,b+k,c-k);
end;
begin
fillchar(v,sizeof(v),false);
fillchar(ans,sizeof(ans),false);
assign(input,'milk3.in');reset(input);
assign(output,'milk3.out');rewrite(output);
readln(va,vb,vc);
dfs(0,0,vc);
flag:=false;
for i:=0 to vc do
if ans[i] then
if flag then write(' ',i)
else begin
write(i);
flag:=true;
end;
writeln;
close(input); close(output);
end.
========================================= 华丽的分割线 =========================================
Prime Palindromes
USER: C Gang [cgangee1] TASK: pprime LANG: PASCAL Compiling... Compile: OK Executing... Test 1: TEST OK [0.108 secs, 844 KB] Test 2: TEST OK [0.108 secs, 844 KB] Test 3: TEST OK [0.108 secs, 844 KB] Test 4: TEST OK [0.119 secs, 844 KB] Test 5: TEST OK [0.108 secs, 844 KB] Test 6: TEST OK [0.108 secs, 844 KB] Test 7: TEST OK [0.151 secs, 844 KB] Test 8: TEST OK [0.140 secs, 844 KB] Test 9: TEST OK [0.162 secs, 844 KB]
{
ID:cgangee1
LANG:PASCAL
TASK:pprime
}
var i,j,k,m,n,l:longint;
procedure init;
begin
if (1>=m)and(1<=n) then writeln(1);
if (2>=m)and(2<=n) then writeln(2);
if (3>=m)and(3<=n) then writeln(3);
if (5>=m)and(5<=n) then writeln(5);
if (7>=m)and(7<=n) then writeln(7);
end;
function su(k:longint):boolean;
var i:longint;
begin
for i:=2 to round(sqrt(k)) do
if k mod i=0 then exit(false);
exit(true);
end;
procedure deal(p:longint);
var i,j,k,l,lim:longint;
begin
lim:=round(exp(ln(10)*p));
i:=lim div 10;
while i<lim do
begin
l:=i;
k:=i*round(exp(ln(10)*p));
for j:=1 to p do
begin
inc(k,l div round(exp(ln(10)*(p-j)))*round(exp(ln(10)*(j-1))));
l:=l mod round(exp(ln(10)*(p-j)));
end;
if (m<=k)and(k<=n)and(k mod 2<>0) then
if su(k) then writeln(k);
inc(i);
end;
{===================================}
lim:=round(exp(ln(10)*p));
i:=lim div 10;
while i<lim do
begin
l:=i;
k:=i*round(exp(ln(10)*(p+1)));
for j:=1 to p do
begin
inc(k,l div round(exp(ln(10)*(p-j)))*round(exp(ln(10)*(j-1))));
l:=l mod round(exp(ln(10)*(p-j)));
end;
for j:=0 to 9 do
begin
l:=k;
inc(l,round(exp(ln(10)*p))*j);
if (m<=l)and(l<=n)and(l mod 2<>0) then
if su(l) then writeln(l);
end;
inc(i);
end;
end;
begin
assign(input,'pprime.in');reset(input);
assign(output,'pprime.out');rewrite(output);
readln(m,n);
init;
deal(1);
deal(2);
deal(3);
deal(4);
close(input); close(output);
end.
========================================= 沉默的分割线 =========================================
prefix
写了我一个半小时的键树,
有个地方少打了个over, 害我调试了半天
写了完了看题解, 原来可以hash判重……
but 也练了一下键树, 查找速度还不错
哎~ 又12点了,不知道明天早上醒不醒的来
{
ID:cgangee1
LANG:PASCAL
TASK:prefix
}
type node=^nd;
nd=record bro,son:node; ch:char; over:boolean; end;
var i,j,k,m,n,l:longint;
a:array[1..200]of string;
f:array[1..200000]of longint;
s:ansistring;
h:node;
procedure ins(s:string; var p:node);
var q:node;
i,j:longint;
ch:char;
begin
ch:=s[1];
delete(s,1,1);
if p=nil then
begin
new(p);
p^.son:=nil;
p^.bro:=nil;
p^.over:=false;
p^.ch:=ch;
if s<>'' then ins(s,p^.son)
else p^.over:=true;
exit;
end;
if p^.ch=ch then
begin
if s<>'' then ins(s,p^.son)
else p^.over:=true;
end
else begin
if p^.bro=nil then
begin
new(p^.bro);
p^.bro^.ch:=ch;
p^.bro^.son:=nil;
p^.bro^.bro:=nil;
p^.bro^.over:=false;
if s<>'' then ins(s,p^.bro^.son)
else p^.bro^.over:=true;
end
else ins(ch+s,p^.bro);
end;
end;
procedure init;
var i,j,k:longint;
t:ansistring;
begin
readln(t);
while t<>'.' do
begin
inc(m);
for i:=1 to length(t) do
if t[i]=' ' then inc(m)
else a[m]:=a[m]+t[i];
readln(t);
end;
while not(eof) do
begin
readln(t);
s:=s+t;
end;
h:=nil;
for i:=1 to m do ins(a[i],h);
end;
function max(i,j:longint):longint;
begin
if i>j then exit(i);
exit(j);
end;
procedure search(now:longint; p:node);
var j,k:longint;
begin
if p=nil then exit;
if s[now]=p^.ch then
begin
if p^.over then f[i]:=max(f[i],now-i+1+f[now+1]);
if now+1<=length(s) then search(now+1,p^.son);
end
else begin
if p^.bro<>nil then search(now,p^.bro);
end;
end;
begin
assign(input,'prefix.in');reset(input);
assign(output,'prefix.out');rewrite(output);
init;
for i:=length(s) downto 1 do search(i,h);
writeln(f[1]);
close(input); close(output);
end.
还没有评论