Program rq_120;
Type
jj = Array[1..1000] Of Integer;
qq = Array[1..5] Of Dword;
xx = Array[1..100000] Of Dword;
ss = Set Of 0..5;
Var
m, n, l, p, q, i, d: Integer;
a: jj;
b: qq;
s: ss;
Function judge(zh: Dword): Boolean;
Var i: Integer;
Begin
judge := True;
For i:=2 To Trunc(Sqrt(zh)) Do
If zh Mod i = 0 Then Begin
judge := False;
Break;
End;
If judge Then Inc(q);
End;
Procedure mul(r: Dword; Var e: jj);
Var i: Integer;
Begin
e[1] := e[1] * r;
If e[1] >= 10 Then l := 2;
For i:=2 To l Do Begin
e[i] := e[i] * r;
e[i] := e[i] + e[i - 1] Div 10;
e[i - 1] := e[i - 1] Mod 10;
End;
While e[l] >= 10 Do Begin
Inc(l);
e[l] := e[l - 1] Div 10;
e[l - 1] := e[l - 1] Mod 10;
End;
End;
Procedure ycl(c: qq);
Var i, t: Integer;
Begin
d := 0;
t := 1;
For i:=1 To m Do Begin
d :=d + c[i] * t;
t := t * 10;
End;
If judge(d) Then mul(d, a);
End;
Procedure try(k: Integer);
Var i: Integer;
Begin
For i:=1 To n Do
If i In s Then Begin
s := s - [i];
b[k] := i;
If k = m Then ycl(b);
s := s + [i];
End;
End;
Begin
Read(m, n);
s := [1..n];
Fillchar(a, sizeof(a), 0);
Fillchar(d, sizeof(d), 0);
Fillchar(b, sizeof(b), 0);
a[1] := 1;
l := 1;
q := 0;
try(1);
If q = 0 Then Write(’0’)
Else For i:=l DownTo 1 Do Write(a[i]);
ReadLn
End.
似乎有本质性错误,好象哪里运行时卡住了
全乘上去之后,再规整每一位.
边乘边规整前面的进位会对i以后的值造成影响。