Question

pascal的几道题

三、完善程序(40分)
1、求100以内的素数（质数，用筛选法）
program exe6_1;
var a:array[2..100] of boolean; i,k: integer;
begin
for i:=2 to 100 do a[i]:=true;
for i:=2 to 49 do
if a[i] then
for k:=i+1 to do
if i mod k=0 then ;
writeln(‘zhi shu:’);
for i:=2 to 100 do
if then write(i:4);
end.

2. 大部分元素是0的矩阵成为稀疏矩阵，假设有k个非零元素，则可把稀疏矩阵用k*3的矩阵简记之，其中第一行行号，第二列是列号，第三列是该行、该列下的非零元素的值。如：

编程读入一稀疏矩阵，转换成简记形式，并输出。
program p6_12;
const n=5;
var a:array[1..n,1..n] of integer;
b:array[1..100,1..3] of integer;
i,j,k:integer;
begin
writeln('read array a:');
for i:=1 to n do
for j:=1 to n do
read (a[i,j]);
k:=0;
for i:=1 to n do
for j:=1 to n do
if a[i,j]<> then
begin
k:=k+1;
b[k,1]:= ；
b[k,2]:= ;
b[k,3]:= ;
end;
writeln('Xi Shu:');
for i:=1 to k do
begin
for j:=1 to 3 do
write(b[i,j]:3);
writeln;
end;
end.

3、数组a中有n个按降序排列的元素，现要插入一个元素，且插入后a中元素仍是降序。定义过程p对给定的值y，首先找插入位置，然后插入。
type atype=array[1..50] of integer;
var i, count, y: integer; a: atype;
procedure p(var x :atype; y: integer; var m: integer);
var i, k :integer;
begin
if m >=n then writeln(‘out range’)
else begin
k:=1;
while do
k:=k+1;
for i:=m down to k do
x[i+1]:=x[i];

m:=m+1;
end;
end;
begin
readln(count);
for i:=1 to count do
a[i]:=3*i;
for i:=1 to count do
write(a[i]:4);
write(‘y=’); readln(y);

for i:=1 to count do
write(a[i]:4);
writeln;
end.
（注：空行部分为横线）

Answer 1

1、求100以内的素数（质数，用筛选法）
program exe6_1;
var a:array[2..100] of boolean; i,k: integer;
begin
for i:=2 to 100 do a[i]:=true;
for i:=2 to 49 do
if a[i] then
for k:=i+1 to 100 do
if i mod k=0 then a[i]:=false ;
writeln(‘zhi shu:’);
for i:=2 to 100 do
if a[i] then write(i:4);
end.

2.
const n=5;
var a:array[1..n,1..n] of integer;
b:array[1..100,1..3] of integer;
i,j,k:integer;
begin
writeln('read array a:');
for i:=1 to n do
for j:=1 to n do
read (a[i,j]);
k:=0;
for i:=1 to n do
for j:=1 to n do
if a[i,j]<>0 then
begin
k:=k+1;
b[k,1]:=i;
b[k,2]:=j;
b[k,3]:=a[i,j] ;
end;
writeln('Xi Shu:');
for i:=1 to k do
begin
for j:=1 to 3 do
write(b[i,j]:3);
writeln;
end;
end.

3.
type
atype=array[1..50] of integer;

var
i, count, y: integer;
a: atype;

procedure p(var x :atype; y,n: integer; var m: integer); { 用到了n，只好写这了 }
var i, k :integer;
begin
if m>=n then writeln('out range')
else begin
k:=1;
while x[k+1]<y do k:=k+1;
for i:=m downto k do
x[i+1]:=x[i];
x[m]:=y;
m:=m+1;
end;
end;

begin
readln(count);
for i:=1 to count do
a[i]:=3*i;
for i:=1 to count do
write(a[i]:4);
write('y='); readln(y);
p(a,y,50,count);
for i:=1 to count do
write(a[i]:4);
writeln;
end.