Đề học sinh giỏi tỉnh Nghệ An năm 2011 - 2012 môn Tin Học

ĐỀ HỌC SINH GIỎI TỈNH NGHỆ AN NĂM 2011-2012
MÔN TIN HỌC
(Chú ý: Mọi chương trình dưới đây đều được tách ra từng modun nhằm chúng ta hiểu thuật toán, nên không có sự tối ưu về thuật toán để giảm thời gian hay dư thừa dữ liệu.
Quý vị cũng có thể có nhiều cách giải hay hơn).
Bài 1: Nén xâu
Một xâu kí tự có thể nén lại thành 1 một xâu mới bằng cách nén các kí tự giống nhau đứng cạnh nhau. Ví dụ trong xâu AAAA sẽ nén thành 4A. Hãy lập trình để nén 1 xâu kí tự in hoa theo cách trên.
Dữ liệu: vào từ file văn bản NENXAU.INP một xâu, mà các kí tự là chữ cái in hoa.
Kết quả: ghi vào file văn bản NENXAN.OUT một xâu kí tự sau khi nén.
VD: 
Nenxau.inp
Nenxau.out
NNNAAAAFGGH
3N4AF2GH
Ở bài này thì có nhiều cách giải. 
Mình đưa ra một cách giải như sau:
- Nhóm các phần tử giống nhau lại và tính chiều dài của xâu đó.
- Nhóm cuối cùng có thể có số phần tử “bằng” hoặc “không bằng” 1. Nên phải xử lý riêng
Thuật toán: Xâu cần nén là xâu ST
- Đầu tiên tạo 1 xâu có 1 phần tử (S) (chính là ký tự đầu tiên của xâu cần nén (St)) S:=St[1];
- Duyệt từ phần tử thứ 2 đến phần tử cuối cùng: for i:=2 to length(st) do
	+ Gặt phần tử đang xét St[i] bàng S[1] thì cộng vào xâu S luôn.
	+ Nếu St[i] S[1] à Đã hết đoạn các ký tự trùng nhau (Xâu S bây giờ gồm các phần tử giống nhau) à Lưu lại độ dài xâu S vào tệp + 1 ký tự trong xâu S; Tiến hành khởi tại lại xâu S:=St[i] (Bắt đầu đoạn mới)
	for i:=2 to length(st) do
	if St[i]=S[1] then S:=S+St[i]
	else
	Begin
 	if length(s)>1 then write(f,length(s));
	write(f,S[1]);
	S:=St[i];
	End;
- Còn vị trí = length(St) ta chưa lưu lại được
+ sau vòng for trên kia thì xâu S có 2 trường hợp
	- Chỉ một ký tự cuối cùng của xâu St
	- Đoạn cuối cùng của xâu St (nếu có nhiều PT giống nhau)
	if length(s)=1 then write(f,S)
	else write(f,length(s),S[1]);
Chương trình hoàn chỉnh
Program NenXau;
Var St:string;
Procedure Docfile;
var f:text;
Begin
	assign(f,'nenxau.inp'); reset(f);
	readln(f,st);
	close(f);
End;
Procedure XuLy;
var f:text;
	s:string;
	i:byte;
Begin
 assign(f,'nenxau.Out');
 rewrite(f);
	s:=st[1];
	for i:=2 to length(st) do
	if St[i]=S[1] then S:=S+St[i]
	else
	Begin
 	if length(s)>1 then write(f,length(s));
	write(f,S[1]);
	S:=St[i];
	End;
	if length(s)=1 then write(f,S)
	else write(f,length(s),S[1]);
	close(f);
End;
Begin
	docfile;
	XuLy;
End.
Bài 2: Số nguyên tố đối xứng
Một số nguyên dương T được gọi là số nguyên tố đối xứng nếu thỏa mãn các yêu cầu sau:
T là một số nguyên tố
T là một số đối xứng (đọc T từ trái qua phải thu được kết quả giống như đọc T từ phải qua trái). Ví dụ 12321 là 1 số đối xứng.
Yêu cầu: cho 2 số nguyên dương A và B, hãy tìm số lượng các số nguyên tố đối xứng T thỏa mãn A ≤ T ≤ B 100000
Dữ liệu: vào từ file văn bản NTDX.INP gồm 1 dòng chứa 2 số nguyên dương A và B cách nhau 1 dấu cách (104 ≤ A < B <105) 
Kết quả: ghi vào file văn bản NTDX.INP một số nguyên là số lượng số nguyên tố tìm được.
VD 
NTDX.inp
NTDX.out
11111 22222
23
Bài này nếu chúng ta có thể tạo 2 Hàm kiểm tra Tính nguyên tố và Số Đối xứng để kiểm tra tất cả các số trong đoạn A àB có thoả mản là số Nguyên Tố đối xứng không.
Hàm NguyenTo thì chắc chúng ta quyen thuộc rất nhiều rồi.
Hàm Số đối xứng thì cũng có nhiều cách:
Có thể dùng Xâu, tệp, đơn giản nhất là đối thành một số nguyên khác cũng được.
Thuật toán cụ thể như sau: (Thuật Toán này chúng ta dùng đề tìm hiểu, không phải là thuật toán tối ưu đâu nhé)
Program SoNguyenToDoiXung;
Var
	A,B:longint;
Procedure Docfile;
var f:text;
Begin
	assign(f,'ntdx.INp');	reset(f);
	readln(f,A,B);
	close(f);
End;
Function Nt(n:longint):boolean;
var i:longint;
	kt:boolean;
Begin
	kt:=true;
	for i:=2 to trunc(sqrt(n)) do
	if n mod i = 0 then kt:=false;
	NT:=kt;
End;
Function DoiXung(N:longint):boolean;
var 
	N1,N2:longint;
Begin
	N1:=0;
	N2:=N;
	while N0 do
	begin
	N1:=N1*10+ N mod 10;
	N:=N div 10
	End;
	DoiXung:=N1=N2;
End;
Procedure XuLy;
var i:longint;
	d:longint;
 f:text;
Begin
	d:=0;
	for i:= A to B do
	if NT(i) and DoiXung(i) then inc(d);
assign(f,'NTDX.OUT');	Rewrite(f);
 	write(f,d);
	close(f);
End;
Begin
	docfile;
	XuLy;
End.
Bài 3: DÃY SỐ TƯƠNG THÍCH
Cho 2 dãy số nguyên{aN} , {bN}(1<N≤10000, 1≤ai,bi≤8000). Hai dãy số gọi là tương thích nếu:
+ Nếu vị trí I có hai giá trị ai, bi thì bất kì j ≠ i mà ai=aj => bi=bj.
+ Nếu vị trí I có hai giá trị ai, bi thì bất kì j ≠ i mà ai≠aj => bi≠bj.
Yêu cầu: hãy kiểm tra hai dãy {aN},{bN} có tương thích ko?
Dữ liệu: vào từ file văn bản DAYSO.INP:
Dòng đầu ghi số N.
Dòng thứ 2 ghi N số nguyên của dãy số {aN}
Dòng thứ 3 ghi N số nguyên của dãy số {bN}
 (các số trên một dòng ghi cách nhau một dấu cách )
Kết quả: ghi ra file văn bản DAYSO.OUT:
Ghi số 1 nếu tương thích,trong trường hợp ngược lại ghi số 0
VD: 
Dayso.inp
Dayso.out
Dayso.inp
Dayso.out
4
1 2 3 1
3 2 1 3
1
4
1 2 3 1
1 2 3 3
0
 Bài này thì đề có vẻ khó hiểu nhưng tôi chúng ta có thể hiểu như sau
Cho 2 dãy số An, và Bn Hai dãy số đó gọi là tương thích nếu:
Tại vị trí i bất kỳ mà với mọi giá trị ji có (Ai=Aj thì Bi cũng bằng Bj) hoặc (AiAj thì Bi cũng phải khác Bj)
- Bài này ta có thể giả sử ban đầu g2 dãy đó tương thích nhau
Ta chỉ việc tìm ra được một vị trí mà
(Ai=Aj ) nhưng (Bibj)
 hoặc (AiAj) nhưng (Bi=Bj)
Thì lúc đó d2 dãy kia không còn tương thích nữa.
kt:=true;
for i:=1 to N do
 for j:=1 to N do
	if ij then
	if((A[i]=A[j]) And (B[i]B[j])) or ((A[i]A[j]) And (B[i]=B[j])) then
 KT:=false;
Chương trình hoàn chỉnh:
Program DayTuongThich;
Var A,B:array[1..10000] of Integer;
	n:integer;
Procedure DocFile;
Program DaySoTuongThich;
Var f:text;
	i:integer;
Begin
	assign(f,'DaySo.INp'); Reset(f);
	readln(f,n);
	For i:=1 to n do
	read(f,A[i]);
	Readln(f);
	for i:=1 to n do
	read(f,B[i]);
	close(f);
End;
Procedure Xuly;
var i,j:integer;
 f:text;
 kt:boolean;
Begin
	kt:=true;
	for i:=1 to N do
	 for j:=1 to N do
	if ij then
	if((A[i]=A[j]) And (B[i]B[j])) or ((A[i]A[j]) And (B[i]=B[j])) then
 KT:=false;
 assign(f,'DaySo.OUT'); rewrite(f);
 if kt then write(f,1)
 else Write(f,0);
 close(f);
End;
Begin
 DocFile;
 XuLy;
End.