Đang tải... (xem toàn văn)
Nếu dãy không có số hoàn thiện nào thì ghi -1.. Hãy tính số lần lặp của xâu S1 trong xâu S2. Hãy tính tổng S của M và N và tìm số lần xuất hiện của các chữ số trong S... Cấu trúc file nh[r]
(1)MỘT SỐ BÀI TẬP
Bài 1:
Nhập số thực x, x >0 tính bậc hai x, x<=0 thơng báo ‘x số dương’
Bài 2:
In ký tự bảng mã lên hình, hàng 15 ký tự. Bài 3:
Nhập số đo độ góc, tính số đo radian góc đó. Bài 4:
Cho số tự nhiên n, lập trình để tính tổng sau : a + 1/22 + 1/32 + … + 1/n2
b 1 + 1/2! + 1/3! + … + 1/n! Bài 5:
Nhập dãy số thực a Tách riêng số >0 xếp thành dãy tăng
Thuật toán:
B1: Nhập n, dãy {a1, an)
B2: Dùng mảng b để tách số >0. B3: k:=0;
B4: Cho i chạy từ -> n Nếu a[i] >0 thì - 4.1 Tăng k; - 4.2 b[k]:=a[i];
B5: Ra khỏi vòng lặp, dùng thuật toán xếp cho mảng b k>0; B6: In mảng a b.
B7 Kết thúc. Bài 6:
Nhập dãy số thực dương Tách dãy số thành nửa cho trị tuyệt đối hiệu tổng nửa đạt min.
HD:
Đặt s1 tổng nửa đầu (từ số hạng thứ đến số hạng thứ k) s2 tổng nửa sau (từ số hạng thứ k+1 đến số hạng thứ n) s tổng dãy
=> S= s1+s2; Đặt h = │s2-s1│
Khi s2>=s1 h = s2-s1 = s-2s1 Khi s2<s1 h=s1-s2 = 2s1-s
Khởi đầu cho k=0, s1=0, s2=s Khi s2>s1.
Ta thấy Khi k tăng s1 tăng, s2 giảm => h giảm chừng s1<s2 đến lúc s1sẽ >s2 => h tăng theo k h nhỏ thời điểm h thơi giảm.
Thuật tốn: Dùng While
Chừng s2 >s1 tăng k => s1:=s1+a[k] Ra khỏi vòng lặp:
s1 cũ = s1 - a[k];
h' cũ = S - 2S1' cũ = s - 2s1 + a[k]; h= 2s1 - s;
h' - h = 2(2s1 - a[k])
(2)+ Nếu h' - h > => a[k] < 2s1 ta chọn h' (tức lấy k -1) Bài 7:
Nhập vào dãy số thực a gồm n phần tử (5<n<100), tìm tổng phần nhỏ dãy. Bài 8:
Nhập vào dãy số thực a Tìm số dãy tổng số khác dãy. HD: Dùng vòng for lồng nhau:
Cho i chạy từ đến n Cho j chạy từ đến n -1 Cho k chạy từ j+1 đến n
i<>j i <> k a[i] = a[j] + a[k] thì in hình a[i], a[j], a[k]
Bài 8:
Nhập dãy số thực a Tìm max (min) phần tử tìm giá trị đạt max (min). HD:
- Dùng S để tính max ptử. - Khởi đầu S:=a[1]
- Dùng vòng lặp for Cho i: 2->n Nếu S<a[i] s=a[i]
- Ra khỏi vịng lặp S số lớn nhất. - Dùng vòng lặp for Cho i: 1->n Nếu s=a[i] in giá trị i.
Bài 9:
Dãy số sau gọi dãy Fibonaci : a1 = 1
a2 = 1
a3 = 2
a4 = 3
.
an = an-1 + an-2
Viết chương trình tính 20 số Fibonaci đưa kết vào mảng 20 phần tử. Phần xâu:
Bài 10:
Nhập vào xâu ký tự.
a Đếm số lần xuất ký tự xâu.
b Liệt kê ký tự có mặt xâu số lần xuất ký tự đó. HD:
a Dùng biến Cho i chạy từ đến length(xau), lần ký tự xuất tăng biến đếm. b Dùng mảng 255 phần tử, ptử thứ k mảng phụ tránh việc đếm số lần xuất xâu của ký tự thứ k.
Ra khỏi vong lặp, in ký tự có số đếm > 0. Bài 11:
Nhập vào xâu ký tự.
a Xét xem xâu có k ký tự kề mà hay không. b Tất ký tự kề mà để lại một. HD:
Nhập xâu S. n=length(s)
a Dùng biến d để đếm k ký tự kề mà nhau biến d1 để đếm số ký tự vừa đọc.
(3)- Dùng vòng lặp for, cho i chạy từ 1-> n-1 Nếu s[i]=s[i+1] tăng d1
ngược lại cho d1=0; nếu d1+1 >=k tăng d
Ra khỏi vịng lặp, d >0 trả lời có. b Dùng hàm XOA
Nếu ký tự kề thì - Xố bớt ký tự;
- Hàm nhận giá trị true Dùng vòng lặp while
Chừng hàm XOA cịn true cịn vịng lặp Bài 12:
Viết chương trình tìm tất số nguyên tố đoạn m, n (2 <= m < n < 10000). Dữ liệu vào: Từ tệp văn nto.inp gồm dòng chứa số tự nhiên m, n.
Dữ liệu ra: Ghi vào tệp nto.out dòng chứa tất số nguyên tố đoạn m, n Nếu khơng có ghi -1.
Ví dụ:
Nto.inp Nto.out
3 15 3 11 13
8 10 -1
HD:
- Viết hàm kiểm tra số nguyên tố
function nguyento(n:integer): boolean; var j:integer;
begin
nguyento:=true;
if n < then nguyento:=false; for j:=2 to trunc(sqrt(n)) if (n mod j = 0) then
begin
nguyento:=false; break;
end; end;
- Trong thủ tục xử lý ta cho i: m-> n nguyento(i) ghi vào tệp tăng đếm - Nếu đếm = ghi -1 ngược lại ghi đếm.
Bài 13:
Nhập vào xâu ký tự Kiểm tra tính đối xứng xâu Nếu xâu không đối xứng đảo xâu. Dữ liệu vào: Từ tệp văn xau.inp gồm xâu s
Dữ liệu ra: Ghi vào tệp xau.out cấu trúc sau: - Dòng ghi xâu s - Dòng ghi kết quả Bài 14:
Nhập xâu ký tự Đưa xâu dạng chuẩn, nghĩa là: - Khơng cịn trống đầu cuối xâu;
- Khơng cịn trống kề nhau;
- Khơng cịn trống đứng liền sau dấu chấm;
- Ký tự ký tự sau dấu chấm phải viết hoa. Dữ liệu vào: Từ tệp văn xau1.inp gồm xâu s
Dữ liệu ra: Ghi vào tệp xau1.out
Cách làm bai 14:
(4)Dùng vòng lặp while chừng tiếp cịn =true cịn Tiep=false;
nếu cịn trống đầu hay cuối xố trống đó; tiep=true;
nếu cịn trống kề xố bớt trống thứ trống đó; tiep=true;
nếu cịn dấu chấm đứng liền trước trống xố trống đó; tiep=true
Ra khỏi vịng lặp while thực thêm vòng lặp For nữa. Cho i chạy từ đến độ dài xâu-1
nếu s[i]=dấu chấm nâng ký tự s[i+1] thành chữ hoa Cuối nâng ký tự s[1] chữ hoa. Bài 15:
Cho dãy a Hãy tìm số hồn thiện dãy a đó.
Dữ liệu vào: Từ file văn ht.inp gồm một dòng chứa số tự nhiên N (N <=1000) Dữ liệu ra: Ghi vào file văn ht.out gồm dịng số hồn thiện.
Nếu dãy khơng có số hồn thiện ghi -1. HD:
- Sử dụng hàm hoàn thiện function hoanthien(x: longint): Boolean; - Khai báo S, i: longint;
- Gán hoanthien:=false; - S:=0;
- Cho I chạy từ – n div 2 Nếu (x mod i = 0) S:=s + i
nếu s > x khỏi vịng lặp - Nếu s = x hoanthien:=true. Hàm hồn thiện:
function hoanthien(x: longint): Boolean; var s,i: longint;
begin
hoanthien:=false ; S:=0;
for i:=1 to (x div 2) if (x mod i = 0) then begin
S:= S + i;
if s > x then exit; end;
if s = x then hoanthien := true; end;
Bài 16:
Các số phương có dạng N2 được gọi số tứ giác Các số có dạng N(N+1)/2 được
gọi số tam giác.
Ví dụ: Các số tứ giác: 1, 4, 9, 16… Các số tam giác: 1, 3, 6, 10…
Hãy tìm 1000 số số vừa tứ giác vừa tam giác. Dữ liệu vào: Từ file văn Bai16.inp số tự nhiên N (N <= 1000)
Dữ liệu ra: Ghi vào file văn Bai16.out ghi tất số vừa tứ giác vừa tam giác. (Các số ghi dòng phân cách dấu cách trống)
HD:
(5)+ Gán: G4:= false; G3:= false;
+ Cho j chạy từ đến I div thì Nếu j2 = i G4:= true; Nếu j*(j+1)/2 = i G3:=true; - Nếu G4 G3 ghi vào tệp. Bài 17:
Cho dãy số a gồm số tự nhiên Hãy tìm UCLN dãy đó.
Dữ liệu vào: Từ file văn BAI17.INP dòng gồm N số tự nhiên (N <=1000). Dữ liệu ra: Ghi vào file văn BAI17.OUT số UCLN dãy a.
(Các số ghi dòng phân cách dấu cách trống) HD:
function UCLN(a,b: integer): integer; var r : integer;
begin while b<>0
begin r := a mod b; a := b;
b := r; end;
UCLN := a; end;
procedure TinhUC; var i,u : integer; begin
u := a[1]; {u UCLN phần tử từ đến i}
for i := to n u := UCLN(u,a[i]); {là UCLN phần tử từ đến i-1 ai} writeln('UCLN cua ca day la:',u);
end; Bài 18:
Cho dãy số a Hãy kiểm tra dãy số có phải cấp số cộng hay không? Dữ liệu vào: Từ file văn BAI18.INP gồm dòng:
- Dòng ghi số N (N >= 3) số phần tử dãy a; - Dòng dãy gồm N số nguyên.
Dữ liệu ra: Ghi vào file văn BAI18.OUT từ “CO” dãy a dãy cấp số cộng từ “KHONG” dãy a cấp số cộng.
Bài 19:
Cho xâu S1 S2 Hãy tính số lần lặp xâu S1 xâu S2. Dữ liệu vào: Từ file văn vản BAI19.INP gồm dòng:
- Dòng 1: Chứa xâu S1; - Dòng 2: Chứa xâu S2.
Dữ liệu ra: Ghi vào file văn BAI19.OUT số lần lặp xâu S1 xâu S2. Ví dụ:
BAI19.INP BAI19.OUT
aaa
aaaaa 3
Bài 20:
(6)Dữ liệu vào: Từ file văn vản BAI20.INP gồm dòng: - Dòng 1: Chứa số M;
- Dòng 2: Chứa số N.
Dữ liệu ra: Ghi vào file văn BAI20.OUT gồm dòng: Dòng 1: Ghi số nguyên M, N;
Dòng 2: Ghi giá trị tổng S;
- Các dòng ghi số lần xuất chữ số S. Ví dụ:
BAI20.INP BAI20.OUT
2345 -345
2345 -345 2000 0 : 3 2 : 1 Bài 21:
Nhập mảng chiều m dòng, n cột từ file BANGSO.TXT Cấu trúc file sau: dòng đầu 2 số m n, cách dấu cách, m dòng sau, dòng n số nguyên.
a) Hãy in số số nguyên tố mảng b) Tìm vị trí phần tử lớn mảng
c) Sắp xếp dòng mảng tăng dần in mảng dạng ma trận HD
Ta khai báo mảng chiều nhập liệu từ file vào mảng Quá trình nhập từ file văn bản giống nhập từ bàn phím, không cần thực kiểm tra liệu Để xếp mảng theo yêu cầu, ta thực xếp dòng mảng cách viết thủ tục xếp (kiểu đổi chỗ cho đơn giản) coi dòng mảng mảng chiều.
Bài 22:
Nhập vào xâu s đếm xem có từ Từ dãy kí tự, cách dấu cách?
Dữ liệu vào: Từ file văn BAI22.INP xâu S.
Dữ liệu ra: Ghi vào file văn BAI22.OUT số từ xâu. Ví dụ:
BAI20.INP BAI20.OUT
Dai hoc vinh 2010 4 HD:
Cách đếm từ đơn giản đếm dấu cách: s[i] kí tự khác cách s[i-1] kí tự cách thì chứng tỏ s[i] vị trí bắt đầu từ Chú ý từ xâu khơng có dấu cách đứng trước.
S:= ‘ ‘+S; Bài 23:
Nhập vào xâu S in từ đối xứng xâu (Từ dãy kí tự, cách dấu cách) Xâu có từ đối xứng?
Dữ liệu vào: Từ file văn BAI23.INP chứa xâu S. Dữ liệu ra: Ghi vào file văn BAI23.OUT a Nếu xâu có từ đối xừng ghi thành dịng: - Dịng 1: ghi từ đối xứng
- Dòng 2: ghi số từ đối xứng.
b Nếu xâu khơng có từ đối xứng ghi -1. Ví dụ:
BAI20.INP BAI20.OUT
Dai hoc vinh 2002 aga 2002 aga 2
(7)HD
- Tách xâu thành từ Cách đơn giản tiến hành sau:
1) Bỏ qua dấu cách gặp kí tự khác cách (hoặc hết xâu)
2) Ghi kí tự vào xâu tạm gặp dấu cách hết xâu, ta từ. 3) Nếu chưa hết xâu quay lại bước
- Mỗi tìm từ, ta kiểm tra tính đối xứng từ đối xứng ghi vào tệp tăng biến đếm Ta lưu từ tách vào mảng tập yêu cầu dùng đến những từ câu sau.
- Kết thúc xâu ta ghi đếm vào tệp. Bài 24:
Một số nguyên gọi palindrom đọc từ trái sang đọc từ phải sang
- Dữ liệu vào: Từ file text BAI24.INP dãy n phần tử nguyên dương, 5<= n<=20 và các phần tử có đến chữ số
- Dữ liệu ra: Ghi vào file text BAI24.OUT dòng gồm số palindrom Nếu dãy khơng có số palindrom ghi -1.
Các số ghi cách dấu cách trống HD:
Một số palindrom xâu tương ứng xâu đối xứng Ta xây dựng hàm kiểm tra một số có phải palindrom khơng cách chuyển số thành xâu kiểm tra xâu có đối xứng không?
function palindrom(k : integer): boolean; var x,y : string;
i : integer; begin
str(k,x); {chuyển k thành xâu x} y := '';
for i := length(x) downto
y := y + x[i]; {nếu x đối xứng k palindrom} if x=y then palindrom := true else palindrom := false; end;
Bài 25:
Tìm tất số AMSTRONG đoạn m, n (100<=n < m <=999; n, m N*)
(Số AMSTRONG số có ba chữ số cho tổng lập phương chữ số số đó) Dữ liệu vào: Từ file văn BAI25.INP dòng gồm số nguyên dương m, n
Dữ liệu ra: Ghi vào file văn BAI25.OUT dòng gồm số AMSTRONG nằm trong đoạn m, n Nếu đoạn khơng có số thoả mãn ghi -1.
HD:
Dùng vòng for lồng nhau: For x:=1 to do
For y:=0 to do For z:=0 to do
(8)CHƯƠNG TRÌNH MẪU Bài
a)
Var n , i : Word ; S : Real ; BEGIN
Write (' Nhap n : ') ; Readln (n) ; S := ;
For i := To n Do S := S + / sqr(i) ; Writeln (' S = ', S:0:2) ; Readln ;
END b)
Var n , i , j , p : Word ; S : Real ;
BEGIN
Write (' Nhap n : ') ; Readln(n) ; p := ;
s := ;
For i :=1 To n Do Begin
p := p * i ; (* tính i *) S := S + / p ;
End ;
Writeln (' S = ', S:0:2) ; Readln ;
END
Bài 5:
Var a,b: array[1 100] of real; i,j,k,n: Integer;
x: real; BEGIN
Write(nhap n = '); readln(n); Writeln('Nhap day so');
K:=0;
For i:= to n Begin
Read(a[i]); If a[i]>0 then Begin
Inc(k); b[k]:=a[i]; end;
end;
for i:=1 to k-1
for j:= i+1 to k if b[i] > b[j] then Begin
x:=b[i]; b[i]:=b[j]; b[j]:=x; end;
if k=0 then writeln('khong co so duong') else for i:= to k write(b[i]:0:1);
(9)Bài 6:
C1: program bai6; uses crt;
var a,h:array[1 100] of integer; i,n,k,s,s1,s2,min:integer; begin
clrscr;
write('nhap mang');
write('moi nhap so ptu n= ');readln(n); s:=0;
for i:=1 to n begin
write('a[',i,']= ');readln(a[i]); s:=s+a[i];
end;
for i:=1 to n write(a[i]:3);writeln; s1:=0;s2:=s;
for i:=1 to n-1 begin
s1:=s1+a[i]; s2:=s2-a[i]; h[i]:=abs(s2-s1); end;
for i:=1 to n-1 write(h[i]:3); writeln; min:=h[1];
for i:=2 to n-1 if h[i]<min then min:=h[i];
writeln('gtri hieu nho nhat la: ',min); for i:=1 to n-1
if h[i]=min then
writeln('vi tri tach: ',i:6); readln
end C2:
Var a: array[1 100] of real; i,k,n: Integer;
S1,S: real; BEGIN
Write('nhap so pt cua day'); readln(n); S:=0;
For i:=1 to n Begin
Read(a[i]); S:=S+a[i]; End;
Readln;
k:=0; s1:=0;s2:=s; while s2 > s1 begin
inc(k); s1:=s1+a[k]; end;
if a[k] < (2*s1-s) then begin
s1:=s1-a[k]; k:=k-1; end;
Writeln('day dau tu den',k,'co tong s1=',s1:0:2); Writeln('day sau tu k+1 den',n,'co tong s2=',S-s1:0:2); Readln;
(10)Bài 9:
Var
a : Array[1 20] Of Byte ; i : Byte ;
BEGIN
a[1] :=1; a[2] :=1;
For i:=3 to 20 a[i]:=a[i-1]+a[i-2] ; END
Bài 10:
C1:
{var s:string;
ch:char; dem,i:integer; begin
write('Nhap xau:');readln(s); write('Nhap ki tu:');readln(ch); dem:=0;
for i:=1 to length(s)
if s[i]=ch then dem:=dem+1; write('dem:',dem:4);
readln; end }
{cau 10b} var s:string; j,i:integer;
a:array [0 255] of byte; begin
write('Nhap xau:');readln(s); for i:=0 to 255 a[i]:=0; for i:=0 to 255
for j:=1 to length(s)
if s[i]= chr(i) then a[i]:=a[i]+1; for i:=0 to 255
if a[i] >0 then writeln('ki tu',chr(i),' xuat hien', a[i]:4,'lan'); readln;
end C2:
program xau; uses crt;
var st:string;
i,j,d:integer;ch:char; begin clrscr;
write('nhap xau ki tu: ');readln(st); { write('nhap ki tu bat ki: ');readln(ch); for i:=1 to length(st)
if st[i]=ch then d:=d+1;
write('so lan xh ki tu ',ch,' xau la ',d);} for j:=0 to 255
begin d:=0;
for i:=1 to length(st) if ord(st[i])=j then d:=d+1; if d<>0 then
writeln('so lan xh ktu ',chr(j),' la: ',d); end;
(11)end C3:
Type dem = array[#0 #255] of integer; Var t: dem;
I,d,n: integer; Ch:char;
S:string; BEGIN
Wite('Nhap xau:'); readln(s); N:=length(s);
Write('nhap ky tu can dem'); readln(ch); D:=0;
For i:=1 to n
If s[i]=ch then inc(d);
Wrieln('ky tu',ch,'co mat',d,'lan'); For ch:= #0 to #255 t[ch]:=0; For i:=1 to n inc(t[s[i]]); For ch:= #0 to #255
If t[ch] >0 then
Writeln('ky tu',ch,'co mat',t[ch],'lan'); Readln;
END
Bài 11:
Var i,d,d1,n,k: integer; S:string;
FUNCTION XOA: Boolean; Var i: integer;
Begin
XOA:= false;
For i:=1 to length(s)-1 If s[i]=s[i+1] then
Begin
Delete(s,i,1); XOA:=true; Exit; End; End;
BEGIN
Write('nhap xau:'); readln(s); Write('nhap so k:'); readln(k); N:=length(s);
D:=0; d1:=0;
For i:=1 to n-1 Begin
If s[i]=s[i+1] then Inc(d1)
Else d1:=0;
if d1+1 >= k then inc(d); end;
if d > then
writeln('co', k, 'ky tu ke nhu nhau') else
writeln('khong co', k, 'ky tu ke nhu nhau') while XOA
writeln('in lai xau'); writeln(s);
readln; END
Bài 12:
(12)var n,m:word; d,i:word; f1,f2:text;
function nguyento(n:integer): boolean; var j:integer;
begin
nguyento:=true;
if n < then nguyento:=false; for j:=2 to trunc(sqrt(n)) if (n mod j = 0) then
begin
nguyento:=false; break;
end; end;
procedure doctep; begin
assign(f1,fi); reset(f1); while not eoln(f1) read(f1,m,n);
close(f1);
assign(f2,fo); rewrite(f2); end;
procedure xuly; begin
d:=0;
for i:=m to n if nguyento(i) then begin
write(f2,i,' '); d:=d+1;
end;
if d=0 then write(f2,-1); close(f2);
end; BEGIN
doctep; xuly; END
Bài 13:
Program Hoan_thien_; const fi = 'ht.inp'; fo = 'ht.out'; Var n,i,k : integer;
A: array[1 1000] of longint; f1,f2 : text;
Procedure doc; begin
assign(f1,fi); reset(f1); n:=0;
while not eof(f1) begin
n:=n+1;
read(f1,a[n]); end;
close(f1); end;
function hoanthien(x: longint): Boolean; var s,i: longint;
begin
(13)for i:=1 to (x div 2) if (x mod i = 0) then begin
S:= S + i;
if s > x then exit; end;
if s = x then hoanthien := true; end;
Procedure viet; Begin
assign(f2,fo); rewrite(f2); for i:=1 to n
if hoanthien(a[i]) then write(f2,a[i],' '); close(f2);
end; BEGIN doc; viet; END
Bài 15:
Procedure doc; begin
assign(f1,fi); reset(f1); n:=0;
while not eof(f1) begin
n:=n+1;
read(f1,a[n]); end;
close(f1); end;
function hoanthien(x: longint): Boolean; var s,i: longint;
begin
hoanthien:=false ; S:=0;
for i:=1 to (x div 2) if (x mod i = 0) then begin
S:= S + i;
if s > x then exit; end;
if s = x then hoanthien := true; end;
Procedure viet; Begin
assign(f2,fo); rewrite(f2); for i:=1 to n
if hoanthien(a[i]) then write(f2,a[i],' '); close(f2);
end; BEGIN doc; viet; END
Bài 17:
Const fi = 'bai17.inp'; fo = 'bai17.out'; var i,j,n: word;
(14)f1,f2: text; procedure chuanbi; begin
assign(f1,fi); reset(f1); n:=0;
while not eof(f1) begin
inc(n);
read(f1,a[n]); end;
assign(f2,fo); rewrite(f2); end;
function UCLN(a,b: integer): integer; var r : integer;
begin
while b<>0 begin
r := a mod b; a := b;
b := r; end;
UCLN := a; end;
procedure TinhUC; var i,u : integer; begin
u := a[1]; {u la UCLN cua cac phan tu tu den i} for i := to n
u := UCLN(u,a[i]); {la UCLN cua cac phan tu tu dun i-1 va ai} write(f2,u);
end;
Procedure dongtep; begin
close(f1); close(f2); end;
BEGIN
chuanbi; tinhUC; dongtep; END
Bài 18:
var f1,f2 :text; i,n,d:longint;
a: array[1 100] of integer; kt: boolean;
begin
assign(f1,'BAI18.INP'); reset(f1); assign(f2,'BAI18.OUT'); rewrite(f2); readln(f1,n);
kt:= true;
for i:=1 to n read(f1,a[i]); d:=A[2] - A[1]; for i:= to n
if A[i] - A[i-1] <> d then kt:= false;
if kt then write(f2,'CO') else write(f2,'KHONG');
(15)Bài 19:
program tinh_so_lan_lap_cua_s1_trong_s2; Const fi = 'BAI19.INP';
fo = 'BAI19.OUT'; Var f1,f2: text; s1,s2: string; i,dem,l1,l2: byte; procedure chuanbi;
begin
assign(f1,fi); reset(f1); while not eoln(f1) read(f1,s1);
readln(f1); read(f1,s2); close(f1);
assign(f2,fo); rewrite(f2); end;
{procedure xuly; begin
dem:=0;
l1:=length(s1); l2:=length(s2); if (l1 <= l2) then
for i:= to (l2-l1+1) if s1=copy(s2,i,l1) then inc(dem);
write(f2,dem); close(f2); end; }
procedure xuly; begin
i:=pos(s1,s2); dem:=0;
while i > begin
delete(s2,1,i); inc(dem);
i:=pos(s1,s2); end;
write(f2,dem); close(f2); end;
BEGIN
chuanbi; xuly; END
Bài 20:
Program Tim_so_lan_xuat_hien_chu_so; Const fi=’bai20.inp’;
Fo=’bai20.out’; Var M,N,i,tg: longint; S: Longint;
A:array[0 9] of byte; f1,f2:text;
procedure chuanbi; begin
assign(f1,fi); reset(f1); assign(f2,fo); rewrite(f2); while not eof(f1)
(16)procedure xuly; begin
For i:=0 to A[i]:=0; S:=M+N;
Writeln(f2,M,' ',N); writeln(f2,S);
S:=abs(S); While S > begin
tg:=S mod 10; inc(A[tg]); S:=S div 10; end;
for i:=0 to if A[i] <> then
writeln(f2,i,' : ',A[i]); End;
procedure dongtep; begin
close(f1); close(f2); end;
BEGIN
chuanbi; xuly; dongtep;
END.Bài 21:
var m,n : integer;
a : array[1 100,1 100] of integer; (* Nhập liệu *) procedure nhap;
var f : text; i,j : integer; begin
assign(f,'BANGSO.TXT'); reset(f); readln(f,m,n);
for i := to m
for j := to n read(f,a[i,j]); close(f);
end;
function ngto(k : integer): boolean; var i : integer;
begin
ngto := false; if k < then exit;
for i := to round(sqrt(k)) if k mod i = then exit;
ngto := true; end;
procedure inngto; var i,j : integer; begin
writeln('Cac phan tu nguyen to cua mang:'); for i := to m
for j := to n
if ngto(a[i,j]) then write(a[i,j],' '); writeln;
end;
procedure timmax;
var max,i,j,im,jm : integer; begin
max := a[1,1];
(17)for j := to n if max < a[i,j] then
begin
max := a[i,j]; {mỗi lần gán max gán toạ độ luôn} im := i; jm := j;
end;
writeln('Phan tu lon nhat bang la A[',im,',',jm,']=',max);
end; {Thủ tục thực xếp tăng dần dịng thứ k Các phần từ dịng k có dạng a[k,i]}
procedure xepdong(k: integer); var i,j, tg : integer;
begin
for i := to n
for j := i+1 to n if a[k,i] > a[k,j] then
begin tg := a[k,i]; a[k,i] := a[k,j];
a[k,j] := tg; end;
end;
procedure sapxep; var i,j : integer; begin
for i := to m xepdong(i); {sắp xếp dòng} writeln('Mang sau sap xep:');
for i := to m
begin {in dạng ma trận}
for j := to n write(a[i,j] : 5); {in phần tử dòng}
writeln; {in hết dịng xuống dịng} end;
end;
BEGIN
nhap; inngto; timmax; sapxep; END
Bài 22:
Const fi = 'BAI22.INP'; fo = 'BAI22.OUT'; Var f1,f2: text; s: string; i,l: byte;
function sotu(s : string) : integer; var i, dem : integer;
begin
{cong them dau cach phia truoc xau de dem ca tu dau tien} s := ' ' + s; dem := 0;
for i := to length(s) {s[i] la vi tri bat đau tu} if (s[i-1]=' ') and (s[i]<>' ') then dem := dem + 1;
sotu := dem; end;
procedure chuanbi; begin
assign(f1,fi); reset(f1); while not eoln(f1) read(f1,s);
close(f1);
(18)procedure xuly; begin
write(f2,sotu(s)); close(f2);
end; BEGIN
Chuanbi; Xuly; END
Bài 23:
C1:
Const fi = 'BAI23.INP'; fo = 'BAI23.OUT'; Var f1,f2: text; s: string; i,l: byte; dem : integer; procedure chuanbi; begin
assign(f1,fi); reset(f1); read(f1,s);
assign(f2,fo); rewrite(f2); end;
{Ham kiem tra tu doi xung}
function doixung(x : string) : boolean; var y : string;
i : integer; begin
y := '';
for i := length(x) downto y := y + x[i];
if x=y then doixung := true else doixung := false; end; {Thu tuc thuc hien tach tu}
procedure xuly;
var i, len : integer; t : string;
begin
i := 1; len := length(s); repeat
{B1: bo qua cac dau cach cho den het xau hoac gap ki tu khac cach:}
while (s[i]=' ') and (i<=len) inc(i); if i>=len then break; {neu het xau thi dung} t := ''; {t la bien tam luu tu dang tach}
{B2: lay cac ki tu khac cach dua vao bien tam cho den het xau hoac gap ki tu cach:}
while (s[i]<>' ') and (i<=len) begin
t := t + s[i]; inc(i);
end;
{in tu vua tach duoc va kiem tra doi xung} if doixung(t) then
begin
write(f2,t,' '); inc(dem);
end;
until i >= len; writeln(f2); write(f2,dem);
if dem=0 then write(f2,-1); end;
(19)begin
close(f1); close(f2); end;
(************************************************) BEGIN
chuanbi; xuly; dongtep; END
C2:
ROGRAM BT23;
CONST F0='Bai23.INP'; FI='BT23.OUT'; VAR S1,s, TU: STRING; D: INTEGER;
F1, F2: TEXT;
PROCEDURE XOATRANG(VAR S:STRING); VAR I:BYTE;
BEGIN
WHILE S[1]=' ' DO DELETE(S,1,1);
WHILE S[LENGTH(S)]=' ' DO DELETE(S,LENGTH(S),1); WHILE POS(' ',S)<>0 DO DELETE(S,POS(' ',S),1); END;
FUNCTION TACHTU(VAR S:STRING):STRING; VAR I: BYTE; P:STRING; BEGIN
I:=1; P:= '';
WHILE (I<=LENGTH(S)) AND(S[I]<>' ') DO BEGIN
P:=P+S[I]; INC(I); END;
DELETE(S,1,length(p)+1); {S:=COPY(S,I+1,LENGTH(S)-I);} TACHTU:= P;
END;
FUNCTION KT(TU:STRING):BOOLEAN; VAR A: STRING; I:BYTE; TG:BOOLEAN;
BEGIN
KT:= FALSE; A:='';
FOR I:= LENGTH(TU) DOWNTO DO A:=A+TU[I];
IF A=TU THEN KT:= TRUE; END;
BEGIN
ASSIGN(F1,F0); ASSIGN(F2,FI); RESET(F1); REWRITE(F2);
READ(F1,S1);
XOATRANG(S1); D:=0; WHILE S1<>'' DO BEGIN
TU:= TACHTU(S1); IF KT(TU)THEN BEGIN
WRITE(F2,TU,' '); INC(D);
(20)IF D=0 THEN WRITE(F2,-1) ELSE
BEGIN
WRITELN(F2); WRITE(F2,D); END;