Question

Free Pascal 的几道题目求解题思路（答案最好有）

我需要下列题目的解题思路，而不是直接的答案（如果有答案更好，哎如今像我这样RP好的有几人呢）
1.纯粹素数是这样定义的：一个素数，去掉最高位，剩下的数仍为素数，再去掉剩下的数的最高位，余下的数还是素数。这样下去一直到最后剩下的个位数也还是素数。求出所有小于3000的四位的纯粹素数。 (保存命名ex7.pas)
2.将1至9这几个数字排成3x3方阵，并使每一横行的三个数字组成一个三位数。如果要使第三行的三位数是第二行的两倍，第三行的三位数是第一的三倍，应怎样排法？编程找出所有排法。 (保存命名ex11.pas)

3.对一个具有10个元素的一维数组按升序排序（算法不限）。 (保存命名ex12.pas)
各位高手帮帮忙，高分悬赏，不够追加
饿，忘说了，我是初学者，刚学完数组类型，递归这类的还没学到，能否用简单点的方法

Answer 1

1.不多说了，直接枚举 1000..3000套个FOR 里面判断是否满足，满足就输出
2.觉得可以用搜索阿，搜索应该很简单，1..9肯定不会TLE的
3.快排(附过程，这个要背下来的）
procdure sort(l,r:longint);
var
i,j,x,y:longint;
begin
i:=l;j:=r;x:=a[(i+j) div 2];
repeat
while a[i]<x do inc(i);
{在左边找一个比x大的数}
while x<a[j] do dec(j);
{在右边找一个比x小的数}
if not(i>j) then begin
y:=a[i];a[i]:=a[j];a[j]:=i;
{把较小的数换到左边}
inc(i);dec(j);
end;
until i>j;
{repeat {循环后保证有a[i]左边的数都比右边的小}
if l<j then sort(l,j);
if i<r then sort(i,r);
{递归继续排}
end;
附上第2题程序（没PASCAL无法测试，刚写的）
program sample;
var a:array[1..9]of longint; b:array[1..9]of boolean;
procedure search(k:longint);
var i,j,m,n,q:longint;
begin
if k=11 then begin {如果填满则判断}
m:=a[1]*100+a[2]*10+a[3];
n:=a[4]*100+a[5]*10+a[6];
q:=a[7]*100+a[8]*10+a[9];
if (q=2*n)and(q=3*m) then begin
writeln(m);
writeln(n);
writeln(q);
end;
end else begin {没填满}
for i:=1 to 9 do if b[i] then begin
a[k]:=i;
b[i]:=false;
search(k+1);
b[i]:=true;
end;
end;
end;

begin
fillchar(b,sizeof(b),true);
search(1);
end.

第2题 你数学上试一下 有没有规律的（如果是数组章的作业的话应该会有），没有规律就只能这样。。。
至于第3题建议你把这个算法背下来，这是目前效率最高的排序，去比赛都要用这个，否则会超时，＝你学了这个，你还是要背的，呵呵

Answer 2

对于第一题：
楼上说的，枚举；还有一个优化，就是步长每次加2，然后判断生成数字的末位不为5，这样才有可能是素数，然后一位一位判断。
对于第二题：
还是枚举。优化：在123 to 333 之间找一个数，然后非别翻1倍、2倍、3倍，然后计算这三个数各个位数上的和和积，如和为45 and 积为362880 则为一种排法，输出。
对于第三题：
很简单啊，冒泡、选择、插入、哈希，很多都不用递归的。。。。。

程序：
第一题：
program ex7;
var i,a,b,j,s:longint;
f:0..1;
begin
i:=999;//第一次加2 以后就变成了1001
repeat
i:=i+2;
if i mod 10<>5 then
begin
a:=i;b:=1000;
repeat
f:=1;
for j:=2 to trunc(sqrt(a)) do
if a mod j=0 then begin f:=0;break;end;
if f=0 then break else a:=a mod b;b:=b div 10;
until a=0;
if f=1 then
begin
s:=s+1;
writeln(i);
end;
end;
until i=3000-1;
write(s);
end.
第二题：
program ex11;
var i,a,b,c,l,s,t:longint;
begin
for i:=123 to 333 do
begin
a:=i*1;
b:=i*2;
c:=i*3;
s:=a mod 10+a mod 100 div 10+a div 100+b mod 10+b mod 100 div 10+b div 100+c mod 10+c mod 100 div 10+c div 100;
t:=(a mod 10)*(a mod 100 div 10)*(a div 100)*(b mod 10)*(b mod 100 div 10)*(b div 100)*(c mod 10)*(c mod 100 div 10)*(c div 100);
if (s=45)and(t=362880) then
begin
l:=l+1;
writeln(l,':');
writeln(a);
writeln(b);
writeln(c);
writeln;
end;
end;
write(l);
end.
第三题：
选择：
program ex12_1;
var i,j,t:longint;
a:array[1..10]of longint;
begin
for i:=1 to 10 do
read(a[i]);
for i:=1 to 9 do
for j:=i+1 to 10 do
if a[i]>a[j] then
begin
t:=a[i];a[i]:=a[j];a[j]:=t;
end;
for i:=1 to 10 do write(a[i],' ');
end.
冒泡：
program ex12_2;
var i,j,t:longint;
a:array[1..10]of longint;
begin
for i:=1 to 10 do
read(a[i]);
for i:=10 downto 1 do
for j:=1 to i-1 do
if a[j]>a[j+1] then
begin
t:=a[j];a[j]:=a[j+1];a[j+1]:=t;
end;
for i:=1 to 10 do write(a[i],' ');
end.

Answer 3

1、