PDA

View Full Version : [Pascal 11] Nhờ mọi người chỉnh sửa hộ :)



Shootervinh
25-01-2011, 12:13
Chào mọi người :D
Đề bài như sau:
Viết chương trình tạo mảng hai chiều và xuất ra mảng một chiều từ những phần tử của mảng hai chiều theo thứ tự xoắn ốc thuận chiều kim đồng hồ, từ ngoài vào trong.
Bài mình viết dưới đây sử dụng hàm random cho đỡ phải nhập nhiều, nhưng phần cuối của dãy bị lặp lại vài số. Mọi người chỉnh sao cho không còn bị lặp nữa nhé ạ :)

Program Kim_Dong_Ho;
Uses crt;
Var Au : array[1..10,1..10] of byte;
i,j,x,y,a,b,m,n : byte;
exit : string;
Begin
repeat
clrscr;
write('Chuong trinh tao ngau nhien mang hai chieu gom M dong, N cot ');
write('va dua ra man hinh day cac phan tu duoc sap xep theo thu tu thuan chieu kim dong ho.');
writeln;
repeat
write('Nhap so dong va cot cua mang hai chieu: ');
readln(m,n);
if (m > 10) or (m < 2) or (n > 10) or (n < 2) then
writeln('So dong va cot toi da la 10, toi thieu la 2!');
until (m <= 10) and (m >= 2) and (n <= 10) and (n >= 2);
randomize;
for i:=1 to m do
for j:=1 to n do
Au[i,j]:=random(100);
writeln('Mang hai chieu: ');
for i:=1 to m do
begin
for j:=1 to n do write(Au[i,j]:3);
writeln;
end;
writeln;
writeln('Day duoc sap xep lai la: ');
x:=1; y:=m;
a:=1; b:=n;
repeat
i:=x;
for j:=a to b do write(Au[i,j]:3);
j:=b; x:=x+1;
for i:=x to y do write(Au[i,j]:3);
i:=y; b:=b-1;
for j:=b downto a do write(Au[i,j]:3);
j:=a; y:=y-1;
for i:=y downto x do write(Au[i,j]:3);
a:=a+1;
until (x > y) or (a > b);
writeln;
writeln('Ban muon thoat ? <Y/N)');;
readln(exit);
until exit = 'y';
End.

Link chạy thử : http://www.mediafire.com/?twf5sd5leui6z3b


[=========> Bổ sung bài viết <=========]

Ah mình tìm đc ui` :D
Nếu gặp 1 trong những trường hợp:
- M,N đều lẻ
- M chẵn, N lẻ và M>N
- M lẻ, N chẵn và M<N
thì bị lặp lại 1 vài số.
Thêm vào câu lệnh lặp 2 dòng thì hết :

repeat
i:=x;
for j:=a to b do write(Au[i,j]:3);
j:=b; x:=x+1;
for i:=x to y do write(Au[i,j]:3);
i:=y; b:=b-1;

if (m mod 2 = 1) and (n mod 2 = 1) and (n-m = b-a+1) then break;
if (x > y) or (a > b) then break;

for j:=b downto a do write(Au[i,j]:3);
j:=a; y:=y-1;
for i:=y downto x do write(Au[i,j]:3);
a:=a+1;
until (x > y) or (a > b);

Link hoàn chỉnh : http://www.mediafire.com/?yllg87l92p9p34j