Thực hiện liên tiếp việc đọc một số tự nhiên từ bàn phím. Nếu số vừa được đọc vào là số chính phương thì được thởng thêm một lần đọc, nếu đọc số đã được đọc từ trước thì bị trừ một lần đọc. Nếu số đọc là nguyên tố thì lập tức dừng chương trình. Chương trình cũng dừng lại khi số lần bằng 0. Số lần cho ban đầu là 1. Trong quá trình chơi số lần đọc còn lại luôn hiện trên màn hình. Ai được đọc nhiều lần nhất là người vô địch.
9. Program P3709;
uses crt;
const max=1000;
var sodadoc:array[1..max] of integer; i,k,dem,N:integer;
can:real; nt,kt:boolean;
(************************) BEGIN { Main Program } clrscr;
dem:=1; k:=0; repeat
writeln('So lan doc con lai la :',dem,' lan'); writeln('Ban da doc duoc tat ca:',dem-1,' lan'); { Doc so N }
repeat
write('.'); readln(N);
if N<=0 then writeln(#7'Ban phai doc so tu nhien >0'); until n>0;
kt:=false; nt:=true;
{ Kiem Tra tinh nguyen to cua so N }
{ Neu N la so nguyen to thi nt=true,con lai thi nt=false } case N of 1: nt:=false; 2,3: nt:=true else begin nt:=true;
for i:=2 to (N div 2) do if (N mod i=0) then nt:=false; end;
end; { Case }
if not nt then { Neu N khong nguyen to } begin if k=0 then begin k:=1; sodadoc[1]:=N; end lse { if K<>0 } if k>=1 then begin inc(k);
for i:=1 to k-1 do
if N<>sodadoc[i] then sodadoc[k]:=N { So N chua duoc doc } else kt:=true; { So N da duoc doc roi }
if kt=true then dec(dem) else
begin
can:=sqrt(N);
if (can-trunc(can)=0) then inc(dem) { N la so chinh phuong } end;
end; { If k>=1...} end; { If not kt...}
until (nt=true)or(dem=0);
write('Ban da nhap so nguyen to,hoac ban da het so lan quy dinh'); readln;
END.
10. Viết chương trình thực hiện trò chơi sau:
Thực hiện liên tiếp việc đọc một số tự nhiên từ bàn phím. Nếu số vừa đọc vào là nguyên tố cùng nhau với các số đã đọc thì được thởng một lần đọc, trong trường hợp ngược lại nếu số vừa đọc có chung từ hai ớc số trở lên với một trong số đã đọc thì bị trừ một lần đọc, các trường hợp còn lại thì không có thởng phạt gì. Trò chơi dừng lại khi hết lượt. Số lượt ban đầu là 1.
10. Program P3710;
uses crt;
const Max=10000;
var
sodadoc:array[1..Max] of integer;
dem,i,j,a,b,r,k:integer;
min,N,solan: integer;
kt: boolean;
BEGIN
clrscr;
solan:=1;
k:=0; { Dem so cac so da doc } repeat
{ Doc so tu nhien N>0 }
writeln('So lan doc con lai la :',solan); repeat
write('.');readln(N);
if N<=0 then writeln('Ban phai doc so tu nhien N>=1'); until N>0; if k=0 then begin k:=1; sodadoc[k]:=N; end else { K>=1 } begin inc(k); sodadoc[k]:=N;
{ Kiem tra xem so N vua doc co nguyen to cung nhau voi cac so da doc hay khong } if N<>1 then
kt:=true; i:=1; repeat a:=N; b:=sodadoc[i]; while b<>0 do begin r:=a mod b; a:=b; b:=r; end;
if a<>1 then kt:=false { a va b khong phai la nguyen to cung nhau} else inc(i);
until (i>k-1)or(kt=false); If kt=true then inc(solan)
else { Kiem tra xem so N vua doc co chung tu 2 uoc so } begin { tro len voi 1 trong nhung so da doc khong } i:=0;
repeat inc(i);
a:=N; b:=sodadoc[i]; min:=a;
if min<b then min:=b;
dem:=1; { Dem so uoc so chung cua a va b } for j:=2 to min do
if (a mod j=0) and (b mod j=0) then inc(dem); until (i=k-1)or(dem>=2);
if dem>=2 then dec(solan); end;
end; { If K<>1....} end;
until (solan=0); { Het luot doc } writeln('Ban da het luot choi'); write('Nhan Enter de ket thuc'); readln;
END.
