Các dạng bài tập Pascal cơ bản, chuẩn nhất

ơ ả Ấ Ấ Ể ậ Ị Các bài t p Pascal c b n, KINH ĐI N, khó, R T KHÓ & R T THÚ V

ệ ở ầ ặ (Đ c bi ầ ph n GRAPHIC và ph n GRAPH THEORY ) t

Ầ

Ơ Ả

PH N I

CÁC BÀI TOÁN C B N.

Ấ

Ậ

A/ L P TRÌNH KHÔNG DÙNG C U TRÚC NÀO.

ỉ ượ ạ ớ 1Ch đ ơ c dùng phép nhân, tính a mũ 28 v i không h n 6 phép nhân (khi Test, b n nên cho a=2)

{Tinh a mu 28 chi dung khong hon 6 phep nhan} Uses crt; var a,b:longint; Begin clrscr; Write('Nhap a='); Readln(a); a:=a*a;

a:=a*a; Writeln('a mu 4=',a);

b:=a; {luu a mu 4 vao b} a:=a*a*a; Writeln('a mu 12=',a); a:=a*a; Writeln('a mu 24=',a); a:=a*b; Writeln('a mu 28=',a); Readln End.

sau: Sách ToanA1 250000, Sách Ly 100000, Sách Anh van 150000, ự ẵ 2 Cho s n xâu ký t Sach Mach IC 80000.

Ế Ủ ố ề Ạ ạ ậ ổ ộ ượ Hãy in lên màn t ng s ti n bán các lo i sách thu c xâu nh p vào trên đây. H N CH C A BÀI TOÁN: Không đ c dùng phép gán sau

ặ ươ ự ể ề ổ ng t khác đ tính t ng ti n Tongsotienbansach:=250000+100000+150000+80000 ho c các phép gán t bán!

Uses crt; Const s='GiaiTich2 250000, Vatly1 100000, Anh2 150000, MachIC 80000'; Var so1,so2,so3,so4:longint;k1,k2,k3,k4:integer; Begin Clrscr; Writeln('Xau cho truoc:',s); val('250000',so1,k1); val('100000',so2,k2); val('150000',so3,k3); val('80000',so4,k4); Writeln('= = = = = = = = = = = = ='); Write('Tong so tien ban cac loai sach:',so1+so2+so3+so4); Readln; End.

ầ

ế

Th y Tr n Thông Qu

ố ọ ừ bàn phím vào. ề ử ờ ớ ồ ử ệ ộ ự ể ế ủ t c a hs v cách dùng toán t gán đ ng th i v i toán t quan h trong m t ấ ỳ ấ 3Không dùng b t k c u trúc nào, hãy so sánh hai s đ c t ể (Bài này ki m tra s hi u bi ệ dòng l nh).

Uses crt; Var a,b:integer; check1,check2,check3:Boolean; Begin clrscr; Write('a,b:'); Readln(a,b); check1:=a>b; check2:=a 0) Then Nhuan:=False; End; Case thang Of 1,3,5,7,8,10,12:songay:=31; 4,6,9,11:songay:=30; 2:If nhuan Then songay:=29 Else songay:=28; End;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Writeln; Writeln('Thang ',thang:2,'/',nam:4,' co:',songay,' ngay'); Writeln; Writeln('Bam phim de ket thuc'); Readln End.

ọ ừ ố ự ị ủ ủ ộ ộ bàn phím vào 4 s th c mà tr c a chúng thu c kho ng ị ả [3,0, 3,0]. Tính tr trung bình c ng c a 5 Đ c t chúng.

Test Vào 3 2 1.85 1.05; Ra: Tong=0.20; Trung binh cong=0.4

Uses crt; Var s1,s2,s3,s4,tbc,t:Real; d:byte; Begin clrscr; Write('s1,s2,s3,s4=');readln(s1,s2,s3,s4); tbc:=0;t:=0;d:=0; If (s1>=3.0) and (s1<=3.0) then Begin Inc(d); t:=t+s1; End; If (s2>=3.0) and (s2<=3.0) then Begin Inc(d); t:=t+s2; End; If (s3>=3.0) and (s3<=3.0) then Begin Inc(d); t:=t+s3; End; If (s4>=3.0) and (s4<=3.0) then Begin Inc(d); t:=t+s4; End; tbc:=t/d; Writeln('Tong cua cac so trong khoang [3.0,3.0]=',t:0:2); Write(' va Trung binh cong cua chung =',tbc:0:2); Readln; End.

ộ ươ ị ứ ớ ị ng l ch, in lên màn hình tên năm âm l ch ng v i năm ọ ừ bàn phím vào m t năm d ậ ừ

ậ 6 L p trình đ c t ị ươ ng l ch v a nh p vào. d ụ Ví d . vào:2016, ra: Bính Thân.

Uses crt;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Var Year:integer; Begin clrscr; Write('Cho biet nam duong lich:'); Readln(Year); Write('Nam ',year,' la nam am lich:'); Case (Year Mod 10) of 0:Write('Canh '); 1:Write('Tan '); 2:Write('Nham '); 3:Write('Quy '); 4:Write('Giap '); 5:Write('At '); 6:Write('Binh '); 7:Write('Dinh '); 8:Write('Mau '); 9:Write('Ki '); End;

Case (Year Mod 12) of 0:Write('Than'); 1:Write('Dau'); 2:Write('Tuat'); 3:Write('Hoi'); 4:Write('Ty'); 5:Write('Suu'); 6:Write('Dan'); 7:Write('Mao'); 8:Write('Thin'); 9:Write('Ti'); 10:Write('Ngo'); 11:Write('Mui'); End; Readln; End.

ậ ế ố ươ ứ ấ ỳ ọ ừ ủ ố ậ 7 L p trình cho bi t s La Mã t ng ng c a s th p phân b t k đ c t bàn phím vào.

ụ Ví d vào: 2017; ra:MMXVII.

Write('Nhap so Thap phan can chuyen:'); Readln(n);

Program ThapPhan_LaMa; uses crt; var n:integer; ans:char; Begin clrscr; Repeat Write(n,' > Viet theo chu so La ma la:'); While n>=1000 do Begin Write('M');

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Begin

n:=n1000; End; If n>=900 then Write('CM'); n:=n900; End; If n>=500 then Begin Write('D'); n:=n500; End; If n>=400 then Begin Write('CD'); n:=n400; End; If n>=100 then Begin Write('C'); n:=n100; eND; If n>=90 then Begin Write('XC'); n:=n90; End; If n>=50 then Begin Write('L'); n:=n50; End; If n>=40 then Begin Write('XL'); n:=n40; End; If n>=20 then Begin Write('XX'); n:=n20; End; If n>=10 then Begin Write('X'); n:=n10; End;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

If n=9 then Begin Write('IX'); n:=n9; End; If n>=7 then Begin Write('VII'); n:=n7; End; If n>=5 then Begin Write('V'); n:=n5; End; If n=4 then Begin Write('IV'); n:=n4; End; If n=3 then Begin Write('III'); n:=n3; End; If n=2 then Begin Write('II'); n:=n2; End; If n=1 then Begin Write('I'); n:=n1; End; Writeln; Writeln; Write(' ANOTHER TEST (Y/N)?'); Readln(ans); Until Ans In ['n','N']; End.

ậ ế ố ươ ứ ủ ố ọ ừ C C A BÀI 7). L p trình cho vi ậ t s Th p Phân t ng ng c a s La Mã đ c t ƯỢ Ủ 8 (BÀI TOÁN NG ụ bàn phím vào.. Ví d . vào: MMXVII, ra: 2017.

Ơ (BÀI NÀY KHÓ H N BÀI TRÊN)

Program LaMa_ThapPhan; Uses crt; Var s:string;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Procedure Nhap; Begin Writeln; Write('Nhap vao so Lama:'); Readln(s); End;

Function GtriThphan(s:string; i:integer):Integer; Var x:integer; Function Val(c:char):Integer; Begin Case c of 'M','m':Val:=1000; 'D','d':Val:=500; 'C','c':Val:=100; 'L','l':Val:=50; 'X','x':Val:=10; 'V','v':Val:=5; 'I','i':Val:=1; Else Val:=0; End; End; Begin x:=val(s[i]); If i=Length(s) Then GtriLama:=x Else If x

Begin {Main Prog.} Clrscr; Nhap; Write('Gia tri thap phan cua so La ma vua nhap=',gtriThphan(s,1)); Readln End.

ấ

(Các bài khó: *; Các bài r t khó: **)

Ặ Ấ B2CÁC C U TRÚC L P.

Ặ Ệ Ị B.2.1) L NH L P XÁC Đ NH FOR.

ế ữ ỉ ượ ế ắ ộ ộ c phép dùng m t bi n n a là bi n Logic đ l p trình ướ ả ứ ể ế i bài toán d ự ể ậ i đây: không tính toán c th , hãy so sánh 2 bi u th c sau: (1+1/2016) ^ 2017 và ự ể 9 Ngoài 2 bi n th c (Real) b t bu c, b n ch đ gi (1+1/2017)^2016. (ký t ạ ụ ể ừ “^” hi u là lũy th a)

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Uses crt; Var a,b:Real; i:integer; check:Boolean; Begin clrscr; a:=1+1/2016; b:=1; For i:=1 to 2016 Do Begin a:=a*(1+1/2016); b:=b*(1+1/2017); End; check:=(a>b); If check then Write('(1+1/2016) mu 2017 lon hon (1+1/2017) mu 2016') Else Begin check:=(a=b); If check then Write('(1+1/2016) mu 2017 bang (1+1/2017) mu 2016') Else Write('(1+1/2016) mu 2017 nho hon (1+1/2017) mu 2016'); End; Readln; End.

ề ế ả ậ ơ ử ầ ạ ỉ ậ ả 10 Không dùng thu t toán x lý m ng 2chi u, ch dùng các bi n đ n, l p trình in lên màn hình b ng ượ ố ự ứ ziczac ch a 100 s t nhiên đ u tiên (B n có làm đ c bài này trong 10 phút không?)

0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 90 91 92 93 94 95 96 97 98 99

Ắ Ơ Ể ƯỚ KHÔNG TH CÓ CODE NÀO NG N H N CODE D I ĐÂY!

Uses crt; Var i,j:Byte; Begin clrscr; For i:=0 to 9 do begin For j:=0 to 9 do Write(10*i+j:4); Writeln; end; Readln; End.

ự ế ạ ạ ả ỗ ượ '*', l p trình t o tam giác cân r ng. In k t qu lên màn hình. (B n có làm đ c bài này ậ 11 Dùng ký t trong 10 phút không?)

Uses Crt; Var chcao,i: Byte; Begin clrscr;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Write('Nhap chieu cao tam giac:'); Readln(chcao); Writeln('*':chcao); For i:=2 to chcao1 do Writeln('*':chcaoi+1,'*':2*i2); For i:=1 to 2*chcao1 do Write('*'); Writeln; Writeln; Readln; End.

ậ ộ ể ứ ự ấ ậ ộ ố ố ố ế ổ ừ ướ 12 Nh p m t dãy s nguyên t ằ ti p có t ng b ng s M cho tr bàn phím vào, l p trình tìm trong dãy y b (không k th t ) 3 s liên c.

Uses Crt; Var a:array[1..1000] of integer; n,i,j,k,M:integer; Begin clrscr; Writeln; Write(#32:2,'M='); Readln(M); Write('n='); Readln(n); For i:=1 to n do Begin Write('a[',i,']='); Readln(a[i]); End; Writeln('Cac bo so trong day thoa man yeu cau bai toan la:'); For i:=1 to n do For j:=1 to n1 do For k:=j+1 to n do if (i<>j) and (i<>k) and (j<>k) and (a[i]+a[j]+a[k]=M) then Writeln(a[i]:3,a[j]:3,a[k]:3) Readln; End.

ấ ả ả ủ ố ọ ừ ố ấ ế ả t c các s hoàn h o c a s n tùy ý đ c t ầ bàn phím vào. Yêu c u xu t k t qu theo

ẳ ậ 13 L p trình tìm t Form sau: ạ Ch ng h n, Vào: 1200,

ế

Th y Tr n Thông Qu

If check and Not stop Then Writeln(so); End; Inc(ntmin); End; Writeln; Write(‘Another Test (1/0)?, Come on ) press 1; Stop > press 0:’); Readln(tt); Until tt=0; End.

ớ ộ ệ ậ ậ ướ 16 Không dùng thu t toán đ quy, l p trình tìm và in lên màn dãy FIBONACI v i đ dài cho tr c n.

Program Day_Fibo; Uses crt; Var i,n,f1,f2,fi,fi_1,fi_2:Integer; Begin clrscr; Write(‘Nhap do dai day Fibonaci n=’); Readln(n); Writeln(‘ DAY FIBONACI UNG VOI DO DAI ‘,N,’ LA:’); Writeln; i:=1; f1:=1;f2:=1; fi:=f1+f2; Write(f1:3, f2:3); For i:=3 to n Do Begin Write(fi:5); f1:=f2; f2:=fi; fi:=f1+f2; End; Readln; End.

ướ ố ọ ừ ớ ố ậ Ệ ấ ủ c s chung l n nh t c a N s tùy ý đ c t bàn phím vào. 17 L p trình (PHI Đ QUY) tìm Test. Vào: 72 40 24 48 56, Ra: 8

Uses Crt; Var a:Array[1..100] of integer; n,i,tt: Byte; d: Integer;

Ẫ ẽ ạ Ữ Ệ Ự Ộ ẽ ơ b n nên dùng PHÁT SINH D LI U NG U NHIÊN T Đ NG, s nhanh h n!}

Begin Clrscr; {Có l Repeat {Randomize;} Write(‘ Nhap so luong cac so hang n:’); Readln(n); For i:=1 to n Do Begin Write(‘a[‘,i,’]=’); Readln(a[i]); End; {a[i]:=Random(20);} 8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Writeln(‘Day so vua nhap:’); For i:= 1 to n Do Write(a[i]:3); Writeln; Writeln(‘= = = = = = = = = = = = = = =’); For i:=1 to n1 do Repeat d:=a[i]; a[i]:=a[i+1] MOD a[i]; a[i+1]:=d; Until a[i]=0; Write(‘USC max cua ‘,n,’ so vua nhap la:’,a[n]); Writeln; Write(‘More(1/0)? Continue > 1, Stop > 0:’); Readln(tt); Until tt=0; End.

ươ ươ ệ 18 Tìm nghi m nguyên d ủ ng c a ph ng trình sau:

ọ ừ ớ a) 4x+3y9z=n, v i 0 ≤ x, y, z ≤ 50; n đ c t bàn phím vào.

ặ ướ ị ủ ề ệ ươ ủ ươ Không áp đ t tr c mi n giá tr c a x, y, z hãy tìm nghi m nguyên d ng c a các ph ng trình sau:

ọ ừ bàn phím vào.

ọ ừ b) x + y + z = n ; n đ c t c) x2 + y2 = n; n đ c t bàn phím vào.

5 Bài a)

Uses Crt; Var x,y,z,n,d:integer;

Begin clrscr; Write(‘Nhap n:’); Readln(n); d:=0; For x:=0 to 50 do For y:=0 to 50 do For z:=0 to 50 do If ((4*x+3*y9*z)=n) then Begin Writeln(x:4,y:4,z:4); Inc(d); If (d MOD 20)=0 then Begin Write(‘Go ENTER > xem tiep.’); Readln; End; End; End.

ạ Các bài còn l ư i làm t ong t ự .

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ậ ạ ộ ớ ả 19 L p trình t o b ng ba c t GÓC ứ ị SIN COS, tính giá tr hàm Sin, Cos ng v i góc

o đ n 360

o nên yêu c u m i l n ch hi n lên màn 20 giá tr k t qu , đ ả ể

ế ỗ ầ ỉ ệ ị ế ầ ừ c t c n trái. (Vì có t góc 0 Ế ở ộ ậ XEM TI P: gõ phím ENTER.)

Uses Crt; Var goc:word; gocradian: Real;

Begin clrscr; Writeln(#32:9,’BANG GIA TRI GOC, SIN, COS:’); Writeln(‘ Nho an ENTER de xem tiep.’); For goc:=1 To 360 Do Begin gocradian:=goc*pi/180; Writeln(#32:24,goc,#32:5,sin(gocradian):0:4,#32:3,cos(gocradian):0:4); If (goc MOD 20) = 0 then Readln; End; End.

Ặ Ệ Ị B.2.2) CÁC L NH L P KHÔNG XÁC Đ NH (WHILE. . .DO; REPEAT…UNTIL)

ậ ả L p trình gi i các bài toán sau:

ầ ố ố ớ 20 Tính g n đúng v i sai s 10^6 (1/1000000): s Pi; sinx; cosx; e^x.

ầ ố a) Tính g n đúng s PI.

Program tinhgandung_So_Pi; Uses Crt; Const ss=1E6 Var sp: Real; n, dau: integer; Begin clrscr; n:=0; sp:=0; While (1/(2*n+1))>=ss do Begin If n MOD 2 = 0 then dau:=1 Else dau:=1; sp:=sp+dau*(1/(2*n+1)); n:=n+1; End; Write(‘Gia tri gan dung cua so Pi=’,4*sp:8:4); Readln; End.

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Ố Ạ Ầ Ứ Ọ Ồ Ở b) TÍNH G N ĐÚNG SINX B I CÔNG TH C TRUY H I RÚT G N CÒN 1 S H NG

(cid:0) x sin n x n *( + 1)

ờ ừ ể ầ ầ ở ọ ơ ị đây c n hi u ng m có đ n v đo là Radian (Trong m i Program ắ ố ố ể ớ ộ ố Ơ Ờ

L i nh c không th a: + Đ i s x trong các hàm sin, cos ư ộ ư ố đ nó nh m t h s ). Ắ + và có L I NH C QUAN TR NG H N: Hãy test program v i b s sau: ặ x=0 ho c x=3.1416 (= Ọ (cid:0) ) sinx=0; x=1.5708 (=(cid:0) /2)  sinx=1; x=4.7124 (=3(cid:0) /2) sinx=1

ầ ả ơ

ị và trong đ u luôn có hình nh Vòng Tròn Đ n V : Uses Crt; Const ss=1E6; Var x,S,T: Real; n: Integer; hd:char;

Begin Clrscr; Repeat Write(‘Nhap vao cung x (Radian)cua ham Sin:’); Readln(x); S:=x; T:=x; n:=0; While ABS(T)>=ss Do Begin n:=n+2; T:=T*SQR(x)/(n*(n+1)); S:=S+T; End; Write(‘Sin(x)=’,S:0:6); Writeln; Write(‘More (y/n)? Come on > Press y; Stop > Press n:’); Readln(hd); Until hd In [‘n’,’N’]; End.

Ạ ƯƠ HAI HÀM CÒN L I LÀM T Ự Ể NG T ! Đ Ý:

(cid:0) - x cos 1 + x n n ( *( 1)

+ (cid:0) e 1 x n

8 h 54 m 28/7/2017

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

i:=1; while (so<>0) do Begin temp:=so mod 10; if temp>max then Begin max:=temp; vitri:=i; End; i:=i+1; so := so div 10; End; Write(‘ thi chu so ‘, max,’ la chu so lon nhat va nam o vi tri thu ‘,vitri); Write(‘ ke tu ben phai sang.’); readln; END.

ệ ụ sinh đôi mà ướ ố ự c s t nhiên N (ví d 100). Tìm & hi n lên màn t ặ ố ấ ả t c các c p s nguyên t ố ơ ơ ố ố ố ị sinh đôi là hai s h n kém nhau 2 đ n v )

*28 Cho tr ị ủ giá tr c a chúng không quá N. ( Hai s nguyên t Uses crt; Var so1, so2, so3, so4, n, dem: longint; kt1, kt2: boolean; {kt=kiem tra} Begin clrscr; Write(‘Nhap so tu nhien n:’); Readln(n); Writeln(‘Cac cap so sinh doi < n:’); For so1:=2 to n2 do Begin so4:=2; While (so4<=sqrt(so1)) And (so1 MOD so4<>0) do Inc(so4); If so4>sqrt(so1) then Begin so2:=so1; so3:=so2+2; so4:=2; While (so4<=sqrt(so3)) And (so3 Mod so4<>0) do Inc(so4); If so4>sqrt(so3) then Begin Inc(dem); Writeln(dem,’:’,’(‘,so2,’,’,so3,’)’); End; End; End; Readln; End.

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Th y Tr n Thông Qu

Readln; End.

= = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

Ậ

PH N IIẦ

. L P TRÌNH THEO MODUL

ể ậ ơ ủ ụ

ể Trong Pascal có hai Modul đ ta l p trình Đ n Th . Âý là: * Procedure (Th T c). * (và) FUNCTION (Hàm)

ủ ậ ệ ắ ấ ầ ệ ả t các em c n chú ý và n m th t v ng b n ch t 3 khái ni m sau c a l p trình Modul: ậ ữ ế ụ ộ ụ ệ ề

ậ ng cách truy n data trong l p trình Modul c a Pascal:

ươ ề ề ề ị ế ặ Đ c bi ế aBi n toàn c c (Global Var.) và bi n c c b (Locate Var.) ế bCác khái ni m v tham chi u ủ cHai ph c1. Truy n theo Tham Tr (Transfer By Value Parameters) c2. Truy n theo Tham Bi n (Transfer By Variable Parameters)

ị ạ ướ ế Ể Ị Ế c h t các b n hãy “khai v ” 3 “món” sau ( 3 MÓN “KHAI V ” NÀY KI M TRA XEM CÁC B N Ệ Ạ ể Ọ Ồ ỉ Ể ấ Ậ ệ ể ạ ự ạ ả ủ ỉ ế ả ấ ỉ ỉ i thích t m k t qu ! ƯỢ Ớ Ễ Ị Tr CÓ HI U Đ N T N NG N NGU N CÁC KHÁI NI M a); b) ; c); d) nêu trên không. Vì ch khi hi u rõ ơ ậ ớ th c ch t 4 khái ni m đó, b n m i hòng l p trình đ n th th o): ế Không RUN program, ch dùng bút ghi k t qu c a 3 program sau đây lên gi y + gi BA BÀI “KHAI V ” NÀY KHÔNG D ĐÂU! NH : KHÔNG Đ ả C RUN PROGRAM NHÉ!!!

1. Program Transf_By_Val; Uses Crt; Var so1, so2:integer; Procedure Transf_Val(x, y:integer); Begin Writeln(' Ben trong thu tuc:'); x:=x+15; y:=y+15; Writeln('X=',x); Write('Y=',y); End; Begin {Main Prog.) Writeln('Co che truyen data theo THAM TRI:'); Write('Nhap so thu nhat so1='); Readln(so1); Write('Nhap so thu hai so2='); Readln(so2); Transf_Val(so1, so2); Writeln; Writeln('Ben ngoai thu tuc(tuc la sau truyen Data):'); Writeln('Bay gio so thu 1 so1=',so1); Writeln('Bay gio so thu 2 so2=',so2);

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Writeln('Go ENTER de stop!'); Readln; End.

2. Program Transf_By_Vari_Para; Uses Crt; Var so1, so2:integer;

Procedure Transf_By_Vari_Para(Var x, y:integer); Begin Writeln('Trong than thu tuc:'); x:=x+15; y:=y+15; Writeln(' Tham so X=', x); Writeln(' Tham so Y=', y); End; BEGIN {Main Prog.} Writeln('Co che truyen Data theo THAM BIEN:'); Write('Nhap so thu nhat so1='); Readln(so1); Write('Nhap so thu hai so2='); Readln(so2); Writeln('Sau khi truyen Data (tucla ben ngoai thu tuc):'); Writeln('Bay gio so1=',so1); Writeln('Bay gio so2=',so2); Writeln; Write(' Go ENTER de Stop!'); Readln; END.

3. Program Obser_Transf_Data; Uses Crt; Var a, b: integer; Procedure Obser(Var x, y:Integer); Begin Write(x:3, y:3); x:=2; x:=x+1; y:=2*x; End; BEGIN {Main Prog.} Clrscr; a:=4; b:=5; Write('Cac gia tri a, b:', a,'; ',b); Writeln; Obser(a,b); Writeln('Cac gia tri a, b:',a,'; ',b); Obser(b,a);

8 h 54 m 28/7/2017

ế

Th y Tr n Thông Qu

Th y Tr n Thông Qu

uscln:=a; End;

Function daoso(x:integer):integer; Var y:integer; Begin y:=0; While x>0 do Begin y:=10*y+(x MOD 10); x:=x DIV 10; End; daoso:=y; End;

Procedure Tim; Begin dem:=0; writeln; Writeln; Writeln(#32:18,'Cac so Tam tam thoa man d/kien dau bai:'); Writeln; Writeln(#32:18,' '); For i:=101 to 999 do if uscln(i,daoso(i))=1 Then Begin Inc(dem); Write(i:4); End; Writeln; Writeln; Write(#32:20,'Bang tren day co tong cong ',dem,' so Tam tam.'); End;

Begin clrscr; Tim; Readln; End.

ấ ả ặ ố ớ ạ ố ượ ế t c các c p s Lucasa. (Gi i h n: 1

ấ ả ệ **12. Li t kê t ệ ặ t kê. c p đã li ậ ụ Ví d Vào c n trên: 1000, Ra: (1,1); (5, 25); (6, 36); (25, 625). Có t ặ t c 4 c p Lucasa.

ƯỚ Ấ Ắ CODE D I ĐÂY LÀ NG N NH T!

Uses crt; Var n, i:longint; s1, s2:string; d: byte; hd:char; Begin clrscr; Repeat d:=0; Writeln(' Tim cac cap lucasa_number:'); Repeat Write('Nhap can tren cua gioi han:'); Readln(n); Until (n>1) and (n<2147483647);

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Writeln('Cac cap Lucasa number <=',n,': '); n:=Trunc(Sqrt(n)); For i:=1 to n do If (i MOD 10 in [1, 5, 6]) then Begin Str(i,s1); Str(i*i,s2); If Copy(s2,Length(s2)Length(s1)+1, Length(s1))=s1 Then Begin Inc(d); Writeln('(',s1,',',s2,')'); End; End; Writeln('Tong cong co ',d,' cap LucasaNumbers.'); Write('Go ESc de tro lai chuong trinh!'); Until Readkey = #27; End.

ữ ố ố ố ệ ấ ả ạ ẫ ẳ ạ ầ ố ố Ố ơ t c các s SIÊU NGUYÊN T có không h n 8 ch s . (Các s SIÊU NGUYÊN T dài . Ch ng h n: ố i v n là s nguyên t ố Ố ả ủ ặ ặ ố

t kê t **13. Li ố ữ L là nh ng s mà xóa đi k (k

Function NT(n:longint):boolean; Var i:longint; Begin If (n=0) or (n=1) then NT:=False Else Begin i:=2; While (n mod i<>0) and (i<=sqrt(n)) do i:=i+1; If i> sqrt(n) then NT:=True Else NT:=False; End; End;

BEGIN CLrscr; Write('Nhap so chu so n (n<=8):'); Readln(n); dem:=1; a[dem]:=0;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

For i:=1 to n do Begin kb:=0; For k:=1 to dem do For cs:=0 to 9 do If NT(a[k]*10+cs) then Begin kb:=kb+1; b[kb]:=a[k]*10+cs; End; dem:=kb; For k:=1 to dem do a[k]:=b[k]; End; For k:=1 to dem do Write(a[k]:10); Writeln; Writeln('Co tat ca ',dem,' so sieu nguyen to co ',n,' chu so.'); Readln; END.

= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

Ầ

Ả

PH N III

M NG (ARRAY)

Ả

Ậ

Ả

Ề II_1) M NG 1_CHI U. L P TRÌNH GI

I CÁC BÀI TOÁN SAU:

ấ (Bài khó: *; Bài r t khó: **)

ố ọ ừ ủ ố ự bàn phím vào dãy n s t nhiên. Tìm và in lên màn hình các ướ ộ ố 1 Cho tr ố s nguyên t c đ dài n c a dãy s . Đ c t cùng nhau trong dãy.

Program songuyento_trongday; uses crt; var a:array[1..100] of integer; i,n,j,dem:integer;

Begin clrscr; write(‘Nhap do dai cua day so: ‘); readln(n); writeln(‘Nhap cac phan tu cua mang:’); for i:=1 to n do Begin write(‘a[‘,i,’]=’);readln(A[i]);

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

End;

write(‘Day vua nhap la:’); For i:=1 to n do write(‘ ‘,a[i]); writeln; writeln(‘= = = = = = = = = = = = = = = = =’); write(‘Cac so nguyen to co trong mang la:’); For i:=1 to n do Begin dem:=0; for j:=2 to a[i]1 do Begin If a[i] mod j=0 then dem:=dem+1; End; If dem=0 then write(‘ ‘,a[i]); End; readln; End.

ố ọ ừ ố 2 Cho tr bàn phím vào dãy n s nguyên. Tìm và in lên màn dãy con ng. ướ ộ ấ ồ ạ ẳ

ủ c đ dài n c a dãy s . Đ c t ố ươ dài nh t g m toàn s d Ch ng h n, Vào: 12 4 6 3 21 19 5 7 21 9 2 Ra: 19 5 7 21

Program DayconDuongDainhat; Uses crt; Var a:Array[1..1000] of Integer; n,i,j,k,kmax,id:byte; Begin clrscr; { Randomize;} write(‘Nhap do dai n (2<=n<=1000) cua day so: ‘); readln(n); writeln(‘Nhap cac phan tu cua mang:’); for i:=1 to n do Begin write(‘a[‘,i,’]=’); readln(a[i]); {a[i]:=Random(100);} End; clrscr; writeln(‘Day vua nhap la:’); For i:=1 to n do write(‘ ‘,a[i]); writeln; writeln(‘= = = = = = = = = = = = = = = = = = = = = = = = = =’); kmax:=0; For i:=1 to n do Begin j:=i+1;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

While ((a[i]>0) and

(a[j]>0)) Do Inc(j); k:=ji; if k>kmax then Begin kmax:=k; id:=i; End; End; Writeln(‘Day con gom cac so duong lien tiep dai nhat:’); For i:=id to id+kmax1 do Write(a[i]:4); Readln; End.

ướ Ệ ầ 3 Hai bài d Ậ i đây yêu c u dùng THU T TOÁN PHI Đ QUY: Ề

ế

Th y Tr n Thông Qu

ố ộ c dãy s nguyên có đ dài ề ấ ằ ổ **6 Cho tr ọ ừ n (n đ c t ướ bàn phím vào). Tìm cách chia dãy y thành nhi u dãy con có t ng b ng nhau.

{ Go ESC de ve Program} Uses Crt; const mn=60; Var a,c:Array[1..mn] of word;

Procedure View(n:word); Var i: word; Begin for i:=1 to n do Write(a[i]:4); Writeln; End;

Function Min(a,b: word):word; Begin if a

Procedure RandomGene(t, n:word); {Tao sinh data ngau nhien} var i,s: word; Begin s:=t; For i:=1 to n do Begin a[i]:=min(Random(t),s); s:=sa[i]; if s=0 then s:=t; End; End;

Function Check(tt, n, k: word):boolean; Var t,s,i,m:word; Begin check:=False; t:=tt Div k ; If t*k <> tt then exit; m:=1; c[m]:=0; s:=0; For i:=1 to n do Begin s:=s+a[i]; If s>t then exit;

8 h 54 m 28/7/2017

ầ

Write('More(y/n)?'); Readln(dap); Until dap In['n', 'N']; End.

ấ ữ ầ ử ố ộ thu c dãy s nguyên đã cho.

ỏ ả 10 Tìm kho ng cách nh nh t gi a các ph n t Program Khoangcachmin; uses crt; var a:array[2..1000] of integer; i,n,dmin:integer; hoi:byte;

ế

Th y Tr n Thông Qu

Writeln('Ma tran tam giac duoi:');

For i:=1 to n do Begin For j:=1 to i do write(a[i,j]:4); writeln; End; Writeln('* * * * * * * * * * * * * * * * *');

Writeln(' Cac phan tu thuoc duong cheo chinh:'); for i:=1 to n do Write(a[i,i]:4); writeln;

Writeln('* * * * * * * * * * * * * * * * *');

s1:=0; Writeln(' Cac phan tu thuoc duong // sat ngay PHIA TREN duong cheo chinh:'); For i:=1 to n1 do Write(#32:2,a[i,i+1]); Writeln;

Write('Tong cac phan tu thuoc duong // sat ngay PHIA TREN duong cheo chinh:'); For i:=1 to n1 do s1:=s1+a[i,i+1]; Write(s1:4); Writeln; Writeln('* * * * * * * * * * * * * * * * *'); s2:=0; Writeln(' Cac phan tu nam tren duong // sat ngay PHIA DUOI duong cheo chinh:'); For i:=2 to n do Write(#32:2,a[i,i1]); Writeln; Write('Tong cac phan tu nam tren duong // sat ngay PHIA DUOI duong cheo chinh:'); For i:=2 to n do s2:=s2+a[i,i1]; Write(s2:4); Writeln; Readln; End.

**13 Cho ma tr n vuông c p n (n đ c t bàn phím vào). Tìm: ố ẻ ớ a/ S l ậ l n nh t D ọ ộ ủ ấ ọ ừ ấ Ụ ấ ƯỚ ƯỜ NG CHÉO PH . I Đ ỉ ơ ố ẻ ớ ậ ớ ộ ố l n nh t y+ch ra t a đ c a nó. b/ Tìm ít nh t m t s trong ma tr n l n h n s l ấ ơ ố ẻ ớ ố ượ ấ ố ấ ấ l n nh t đã tìm th y trên đây. ố ớ ng các s l n h n s l c/ Th ng kê s l TEST. Vào:

10 12 47 7 5 45 11 39 19 33 29 20 16 19 20 23

ụ ở ộ ố Ẻ Ra: + S L Max d ồ ạ i ph n t ướ ườ ng chéo ph =39 i đ ơ ố ầ ử ớ l n h n s max + T n t hàng 1, c t 3

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ầ ử ở ơ i ph n t ộ ầ ử ớ ố l n h n max là: 2

ồ ạ + T n t ơ ố ớ l n h n s max hàng 2, c t 2 + S ph n t Program Bt_9; Uses Crt; Type mt=array[1..50,1..50] of integer; Var a:mt; n,i,j,max:byte;

Procedure Input(Var a:mt; n:byte); Var i,j:byte; Begin randomize; For i:=1 to n do For j:=1 to n do a[i,j]:=random(50); { Begin Write('a[',i,',',j,']='); readln(a[i,j]); End; } End;

Procedure View(a:mt; n:byte); Var i,j:byte; Begin For i:=1 to n do Begin For j:=1 to n do Write(a[i,j]:4); Writeln; End; End;

Function Timmax(a:mt; n:byte):byte; Var i,j,m:Byte; Begin max:=0; For i:=1 to n do For j:=1 to n do If ((i+j)>(n+1)) And ((a[i,j] Mod 2)=1) then max:=a[i,j]; If max=0 then Writeln('Khong co so le nao lon nhat duoi duong cheo phu.') Else Begin For i:=1 to n do For j:=1 to n do If ((i+j)>(n+1)) And ((a[i,j] Mod 2)=1) And (max

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

End; Timmax:=max; End;

Procedure Maxindex(a:mt; n,max:byte); Var i,j,dem:byte; Begin dem:=0; For i:=1 to n do For j:=1 to n do if ((i+j)<=n) And (a[i,j]>max) then Begin Inc(dem); Writeln('Ton tai phan tu lon hon max o hang ',i,' cot ',j); End; If dem=0 Then write('Khong co phan tu nao > max.') Else Write('So phan tu lon hon max la:',dem); End;

Begin clrscr; Write('Nhap kich co ma tran VUONG:'); Readln(n); Input(a,n); View(a,n); max:=Timmax(a,n); Maxindex(a,n,max); Readln; End.

ọ ừ bàn phím vào). Tìm: i đ ầ ử ỏ ậ ầ ử ằ ớ ườ ụ ồ ng song song v i đ ng chéo ph , r i tính ườ ổ ng chéo chính. ườ n m trên đ ứ ể ậ ấ *14Cho ma tr n vuông c p n (n đ c t ấ ướ ườ nh nh t d + Ph n t ọ ộ ủ + Nh p vào t a đ c a ph n t ầ ử t ng các ph n t trên đ ng // này và ch a đi m đó.

ế ả ng chéo chính=16 ộ ượ ổ ầ ử ườ ứ ầ c t ng các ph n t trên đ ng ch a ph n TEST. Dùng matrix trên đây, ta có k t qu sau: ướ ườ i đ + Min d ọ ộ + Đ c vào t a đ hàng 1, c t 2 ta đ ớ ụ ọ ử ấ y và // v i chéo ph là 17 (=5+12) t

Program Bt_10; Uses Crt; Type mt=array[1..50,1..50] of byte; Var a:mt; n,i,j,k,l,row,col,ans:byte; min,s:integer;

Procedure Input(Var matrix:mt; ten:char; soh,soc:byte); Var i,j:byte; Begin

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Randomize; For i:=1 to soh do For j:=1 to soc do {matrix[i,j]:=Random(10);} Begin Write(ten,'[',i,',',j,']='); Readln(a[i,j]);

End; End;

Procedure View(matrix:mt; soh,soc:byte); Var i,j:byte; Begin For i:=1 to soh do Begin For j:=1 to soc do Write(matrix[i,j]:3); Writeln; End; End;

Begin Clrscr; Repeat Write('Nhap kich co n cua ma tran vuong:'); Readln(n); Input(a,'a',n,n); Writeln('Matrix vua nhap:'); Writeln; View(a,n,n); Writeln; min:=a[2,1]; row:=2; col:=1; For i:=1 to n do For j:=1 to n do If(i>j) And (min>a[i,j]) Then Begin Min:=a[i,j]; row:=i; col:=j; End; Writeln('Phan tu min o duoi duong cheo chinh:',min); Write('Nhap chi so hang, cot can xu ly:'); Readln(k,l); s:=0; For i:=1 to n do For j:=1 to n do If (i+j=k+l) then S:=S+a[i,j]; Writeln('Tong cac phan tu tren duong // voi duong cheo phu va '); Write('chua phan tu tren hang ',k,' cot ',l,' la:',S); Writeln;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Write('Another Test (1/0)? More > Press 1, Stop > Press 0:'); Readln(Ans); Until ans=0; End.

ậ ậ ắ ố ư ế ệ ả

ạ *15 L p trình t o ma tr n xo n c. L u k t qu vào t p Xoanoc.txt. Program Mt_xoan; Uses Crt; var a:array[1..150,1..150]of word; i,j,n,k:word; f:text;

Procedure View; Begin For j:=1 to n do Begin For i:=1 to n do Write(f,a[i,j]:6); Writeln(f); End; End;

Procedure Datso; Begin inc(k); a[i,j]:=k; End;

Begin clrscr; Write('Nhap kich co ma tran n='); Readln(n); Assign(f,'Xoanoc.txt'); Rewrite(f); j:=1; while k

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ậ c ma tr n vuông c p n. ậ ậ ấ ả ề ộ t c các c t, hàng đ u là hoán ướ ể ố ọ ậ ấ *16 Cho tr ả ậ L p trình ki m tra xem nó có ph i là ma tr n La Tinh không. Ma tr n mà t ị ủ v c a n s g i là ma tr n LaTinh.

{ Test1: Test2:

1 2 3 8 7 9 2 3 1 5 4 6 3 1 2 2 3 1 }

Program Check_Mtran_LaTinh; Uses Crt; type a=Array[1..30,1..30] of Integer; Var mt:a; i,j,n,d:Integer;

Function ktrahang(i:integer):Boolean; Var j,k:integer; check:boolean; Begin ktrahang:=false; For k:=1 to n do Begin check:=false; For j:=1 to n do if k=mt[i,j] then check:=true; If Not check then exit; End; ktrahang:=true; End;

Function ktracot(j:integer):boolean;

var i,k:integer; check:boolean; Begin ktracot:=false; For k:=1 to n do Begin check:=false; For i:=1 to n do If k=mt[i,j] then check:=true; If Not check then Exit; End; ktracot:=true; End;

Begin Clrscr; Write('Nhap kich co ma tran vuong n='); Readln(n); For i:=1 to n Do For j:=1 to n Do

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Begin write('mt[',i,',',j,']=');readln(mt[i,j]); End; writeln('Ma tran vua nhap:'); For i:=1 to n do Begin For j:= 1 to n do write(mt[i,j]:3); writeln; End; writeln; writeln('= = = = = = = = = = = = = = = = ='); d:=0; For i:=1 to n Do If (Not ktrahang(i)) Or (Not ktracot(i)) then inc(d); If d=0 then Write('La ma tran Latinh.') Else Write('khong la ma tran Latinh.'); Readln; End.

ướ ố ứ ể ậ ả ậ ấ ậ 17 Cho tr c ma tr n vuông c p n. . L p trình ki m tra xem nó có ph i là ma tr n đ i x ng không.

ể ma tr n chuy n v ằ A b ng chính ố ứ ộ ậ ườ ầ ử ượ ủ ị c a nó. ế ậ ng chéo. Do v y, n u các ph n t đ c ố ứ là ma tr n vuông ậ ớ ậ M tộ ma tr n đ i x ng ỗ ầ ử ủ M i ph n t ế ướ ạ A=a[i,j] thì v i m i i d ng t d vi ậ ố ứ c a m t ma tr n đ i x ng thì đ i x ng qua đ ọ i, j ta có: a[i, j]=a[j,i].

{Test1: 1 2 3 Test2: 9 5 7 2 4 5 3 1 6 3 5 6 8 4 2 } Program Check_Symetr_ Matrix; Uses Crt; Type a=Array[1..30,1..30] of integer; Var mt:a;i,j,n,d:integer; tt:byte; Begin clrscr; Repeat Write(' Nhap kich thuoc ma tran vuong n:'); Readln(n); for i:=1 to n do for j:= 1 to n do begin write(' Nhap phan tu mt[',i,',',j,']='); Readln(mt[i,j]); end; Writeln; writeln('Ma tran vua nhap:'); Writeln; for i:=1 to n do

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

begin for j:= 1 to n do write(mt[i,j]:3); writeln; end; writeln; d:=0; for i:=1 to n do for j:= 1 to n do If mt[i,j]<>mt[j,i] Then Inc(d); If d>0 Then Write('Ma tra vua nhap Khong Doi Xung.') Else Write('Ma tran vua nhap Doi Xung.'); Writeln; Write('More (1/0)?. More > Press 1, Stop > Press 0:'); Readln(tt); Until tt=0; End.

ươ ậ ẻ ậ ổ ọ ỳ ệ ng (g i khác: ma tr n k di umagic matrix) b c l ộ ằ ằ ổ ỉ ứ ố ớ ượ ậ ạ ố **18 T o ma ph . Đó là ma tr n mà t ng các s ườ ằ ng chéo b ng trên các hàng b ng nhau = t ng các s trên các c t b ng nhau = t ng các s trên hai đ Ẻ ậ ươ Ở ứ ổ ng b c L . nhau . ọ m c t ng quát, toán h c m i ch ch ng minh đ ổ ỉ ạ ượ c: ch t o đ ổ c ma ph

{Nhap xong data nho go ENTER de xem ket qua chay Program}

Program Magic_Matrix; Uses crt, addcrt; Const lim=11; Type mt=array[1..lim,1..lim] of integer; mtktr=array[1..lim,1..lim] of boolean; Var matr:mt; mtcheck:mtktr; ok:boolean; n,i,j,k:integer; ch:char;

ế

Th y Tr n Thông Qu

Else Begin j:=j1; i:=i+1; chinhtoado(i,j,n); Inc(i); if mtcheck[i,j]=true then ok:=true else ok:=false; End; Until ok=false; Drawtab(matr,n); gotoxy(18, 25); write('Go phom bat ky de thoat hay t, T de tiep tuc!'); Repeat Until Keypressed; ch:=Readkey; clrscr; end; End.

Ẻ ể ậ ấ ộ ươ **19 Ki m tra xem m t ma tr n vuông c p n ( n L ) có là ma ph ng không?

{ Test 1: 3 7 1 Test 2: 8 1 6 3 5 7 5 2 9 8 4 5 4 9 2 }

Program Maphuong_Check; Uses Crt; Type mt=Array[1..30,1..30] of Integer; var a:mt; i,j,n,s,s1,s2:integer;

Function shang(i:integer):integer; var j,s:integer; Begin S:=0; For j:=1 to n do s:=s+a[i,j]; shang:=s; End;

Function Scot(j:integer):integer; Var i,s:Integer;

Begin s:=0; For i:=1 to n do s:=s+a[i,j]; scot:=s; End;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Begin clrscr; write(' Nhap kich thuoc n cua ma tran vuong:'); Readln(n); for i:=1 to n do for j:= 1 to n do begin write(' Nhap phan tu a[',i,',',j,']='); Readln(a[i,j]); end; clrscr;

writeln('Ma tran vua nhap:'); for i:=1 to n do begin for j:= 1 to n do write(a[i,j]:3); writeln; end;

s:=shang(1); s1:=0; s2:=0; For i:=1 to n Do Begin If (shang(i)<>s) Or (scot(i)<>s) Then Begin Write('Ma tra vua nhap khong phai ma phuong'); Readln; Exit; End; s1:=s1+a[i,i]; s2:=s2+a[i,n+1i]; End; If (s<>s1) Or (s<>s2) Then Write('Ma tra vua nhap khong phai ma phuong') Else Write('Ma tran vua nhap la ma phuong.'); Readln End.

ầ ử ạ ố ổ ộ ư **20 Cho dãy các s nguyên có đ dài N. Tìm cách chia dãy đã cho thành các đo n có t ng các ph n t nh nhau.

Thoat}

{Go ESC (cid:0) Uses Crt; const mn=60; Var a,c:Array[1..mn] of word;

Procedure View(n:word); Var i: word;

8 h 54 m 28/7/2017

Procedure Xuly;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Var i: Word; Begin If sum>max Then Begin max:=sum; ng:=x; End; End;

Procedure Xuat; var i:Word; Begin Writeln(fo,' Tong max cua cac phan tu da chon=',max); Writeln(fo,'Va cac phan tu ay la:'); For i:=1 to n do Write(fo,a[i,ng[i]]:4,'(',i,',',ng[i],')'); End;

Procedure Chon(i:word); Var j:Word; Begin For j:=1 to n do If b[j] Then Begin x[i]:=j; sum:=sum+a[i,j]; b[j]:=false; if i=n Then xuly else chon(i+1); b[j]:=true; sum:=suma[i,j]; End; End;

Begin clrscr; Doc; Ghi; max:=0; sum:=0; For i:=1 to n Do b[i]:=true; chon(1); Xuat; Close(fo); Writeln('Done! Go ENTER > ve Program; Go F3 > Go MANG.OU: Xem kqua.'); Readln; End.

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Ầ

PH N IV.

XÂU KÝ TỰ

ễ ớ ọ

ừ

(STRING) (Tr bài 1, không có bài nào d v i h c sinh, sinh viên)

ậ

ả

L p trình gi

i các bài toán sau:

ộ ự ữ c a xâu có ứ ữ ấ ừ ủ Ấ Ẩ ơ ề ướ ừ (Word). Gi a các t c m t xâu (dài < 256 ký t ) ch a các t ỉ Ữ Ạ Ộ ừ ự ố , ch GI tr ng). Hãy kh các d u cách gi a các t L I M T D U ọ ư ậ ử ẩ ượ ế ở ấ ộ ứ ấ c k t thúc b i d u cách SPACE,

1/(CHU N HÓA XÂU). Cho tr ộ ấ nhi u h n m t d u cách (ký t ữ CÁCH gi a chúng. Xâu nh v y g i là xâu chu n. ừ ộ (T là m t xâu con không ch a d u cách thu c xâu đã cho mà nó đ ặ ấ ho c d u TAB.) CODE. ses crt; var i:Byte; s:string; Begin Clrscr; Write('Nhap vao xau s co vai dau trong o giua cac tu:'); Readln(s); While s=#32 do Delete(s,1,1); While s[length(s)]=#32 do Delete(s,length(s),1); i:=1; Repeat If (s[i]=#32) and (s[i+1]=#32) then Delete(s,i,1) Else Inc(i); Until i>Length(s); {da xet het cac pt cua xau} Write('Xau da khu trong :',s); Readln; End.

ồ ướ ừ ầ ủ ỗ ừ ữ c m t xâu g m các t mà ch cái đ u c a m i t ữ là ch ườ ỗ ừ ự ầ ủ Ủ Ừ đ u c a m i t Ế ử ng. Hãy s a các ký t ộ ữ thành ch HOA.

Ự Ầ 2/(VI T HOA KÝ T Đ U C A T ) Cho tr th Vào: ton nu nguyet anh Ra: Ton Nu Nguyet Anh CODE. Uses Crt; Const chuthg =['a'..'z']; {Khai bao hang xau} Var xau:string; i,d:Byte; Begin Clrscr; Write(' Nhap xau:'); Readln(xau); d:=length(xau); If xau[1] In chuthg Then xau[1]:=Upcase(xau[1]); For i:=2 to d do If (xau[i1]=#32) and (xau[i] In chuthg) Then xau[i]:=Upcase(xau[i]); Write('Chu cai dau moi tu sua thanh chu hoa:',xau); Readln;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

End.

ướ ủ ộ Ủ c hai xâu s1 và s2. Tính đ dài max c a xâu con

Ộ 3/ (Đ DÀI MAX C A XÂU CON CHUNG). Cho tr chung. Vào: s1=xabcxxabcdxd; s2=aybcyabcdydy Ra do dai max doan chung 2 xau=4

Uses Crt; Var s1, s2:string; Function lonnhat(a,b:integer):integer; Begin If (a>b) then lonnhat:=a Else lonnhat:=b; End; Function DodaiMaxXauchung(Var x,y:string):integer; Var m,n,i,j,v,t,kmax: integer; a:array[1..255] of integer; Begin m:=length(x); n:=length(y); kmax:=0; Fillchar(a,sizeof(a),0); For i:=1 to m do Begin v:=0; For j:=1 to n do Begin t:=a[j]; If x[i]=y[j] then a[j]:=v+1 Else a[j]:=0; kmax:=lonnhat(kmax,a[j]); v:=t; End; End; DodaiMaxXauchung:=kmax; End;

Begin clrscr; Write('xau s1='); Readln(s1); Write('Xau s2='); Readln(s2); Write('Do dai max cua doan chung thuoc 2 xau=',DodaiMaxXauchung(s1,s2)); Readln; End.

Ầ Ữ Ủ Ấ Ả Ạ Ị Ặ Ế Ệ (cid:0) ề ấ ố ỏ ị ệ ằ ự ạ ồ ớ Ọ Ậ *4/ (ĐO N L P (Đ U BÀI L Y TRONG “NH NG VIÊN NG C L P TRÌNH” C A JON BENTLEY Ố ộ Ệ B N D CH TI NG VI T: GIA VI T & MINH TRUNG. NXB TH NG KÊ,11/2002)) Cho xâu s có đ i < j (cid:0) ố ớ dài n. Xác đ nh 2 s i, j th a mãn đi u ki n 1 n và k là s l n nh t sao cho s[i] = s[j], s[i+1] = s[j+1], . . ., s[i+k1] = s[j+k1]. Hai đo n b ng nhau trong s g m k ký t là s[i..i+k1] và s[j..j+k1] v i i

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ộ ủ

ạ ặ ọ và k g i là đ dài max c a đo n l p trong s. Vào s=xabababayyy Ra i, j, k=2, 4, 5

Uses Crt; Var i,j,k:integer;

Procedure Doanlap(s:string; var imax, jmax, kmax:integer); Var n,i,j,v,t:integer; a:array[1..255] of integer; Begin n:=length(s); kmax:=0; FillChar(a,sizeof(a),0); For i:=1 to n do Begin v:=0; For j:=i+1 to n do Begin t:=a[j]; if s[i]=s[j] Then a[j]:=v+1 else a[j]:=0; If kmax

Begin clrscr; Doanlap('xabababayyy',i,j,k); Write('Cac chi so i, j, k cua doan lap:',i:2,j:2,k:2); Readln; End.

Ể Ủ Ọ ể ứ ớ ế ạ t d ng khai tri n ng v i xâu thu g n ố ể ứ ọ ư ấ ấ ố

ể ồ ữ ế ậ t theo lu t sau: ấ ệ ọ ủ ồ ọ **5/ (KHAI TRI N C A XÂU G N) Cho xâu thu g n S. Hãy vi ọ đó. Trong xâu thu g n có th ch a các d u tr ng nh ng các d u tr ng này xem là vô nghĩa nên chúng không xu t hi n trong xâu khai tri n. ể Xâu thu g n c a xâu khai tri n g m các ch cái HOA vi Xm: g m m ch cái X; ế ế ạ ầ ế ầ ụ ữ ọ ầ (s)m: m l n vi t xâu con g n trong S; ỏ m=0 thì b qua đo n c n vi t; m=1 thì không c n vi t m; Ví d . Vào: (AB3(C2D)2(C5D)0)2A3

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ế

Th y Tr n Thông Qu

f:text;

Function Bang(i,k:integer):Boolean; Var j:integer; Begin Bang:=false; For j:=0 to k1 do If (v[ij]<>v[ikj]) Then Exit; Bang:=true; End;

Function Chuan(i:integer):Boolean; Var k:integer; Begin chuan:=false; For k:=1 to (i DIV 2) do If Bang(i,k) then Exit; Chuan:=true; End;

Function Tim(i:integer):Boolean; Begin Tim:=true; While (v[i]<3) do Begin Inc(v[i]); If chuan(i) then Exit; End; Tim:=False; End;

Procedure Ketqua(d:integer); Var i:integer; Begin If d=0 then Write(f,'Vo nghiem') Else Begin Write(f,'Ngiem thu ',d,':'); For i:=1 to n Do Write(f,v[i]); Writeln(f); End; End;

Procedure Timtu(len:integer); Var i:integer; d:longint;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ế

Th y Tr n Thông Qu

ư ữ ệ ế ứ ấ ộ ừ ể ừ ủ ừ c a t đi n (N<=100); N dòng ti p theo ghi các t ố N thu c t ộ ở ậ ể ả ụ ả ả ữ có đ dài <= 20 và ghi trên m t dòng. Dòng cu i cùng ghi văn b n S có không quá 250 ch ọ c mã hóa b i mã Ceasar nói trên. L p trình ch n khóa K đ khôi ph c b n rõ sao cho b n rõ đi n. ế ả ầ ị

ả D li u vào l u trên text file tên là ố ừ CEASAR.IN, dòng th nh t ghi s t ộ ỗ ừ ể đi n, m i t ượ cái đã đ ề ừ ấ ủ ừ ể ứ ch a nhi u t nh t c a t ư ữ ệ D li u ra l u trên text file có tên CEASAR.OU mà dòng đ u ghi giá tr khóa K, dòng ti p theo ghi b n rõ ả ủ c a văn b n mã hóa S. Xem: Vào. CEASAR.IN 7 HANOI YES PEDAGOGICAL HELLO UNIVERSITY ITEM HERO IBOPJAQFEBHPHJDBMAVOJWFSTJUZAJJ  b n mã

CEASAR.OU 1 HANOI PEDAGOGICAL UNIVERSITY II

CODE. Uses crt; Const max=250; fi='Ceasar.In'; fo='Ceasar.Ou'; Type st21=String[21]; tudien=Array[1..max] Of st21; Var td:tudien; ma,vb,kt,gm:string; km,sl,slm:Byte; f:Text; n,k:Byte;

Procedure Init; Var i:Byte; begin kt:=' '; For i:=Ord('A') to Ord('Z') Do kt:=kt+Char(i); kt:=kt+kt; Assign(f,'Ceasar.In'); Reset(f); Readln(f,n); For i:=1 to n Do Begin Readln(f,td[i]); td[i]:=td[i]+' '; End; Readln(f,ma); Close(f); End;

Function Before(c:Char; k:Byte): Char;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Begin Before:=kt[pos(c,kt)+27k]; End;

Procedure Key_Find; Var i,j:Byte; Begin km:=0; slm:=0; For k:=1 to Length(ma) Do Begin vb[0]:=Succ(ma[0]); For j:=1 to Length(ma) Do vb[j]:=Before(ma[j],k); sl:=0; For j:=1 to n Do If pos(td[j],vb)>0 Then sl:=sl+1; If sl>slm Then Begin slm:=sl; gm:=vb; km:=k; End; End; End;

Procedure Result; Begin Assign(f,'Ceasar.Ou'); Rewrite(f); Writeln(f,km); Writeln(f,gm); Close(f); End;

Procedure Proccess; Begin Key_Find; Result; End;

Begin clrscr; Init; Proccess; Write('Done!'); Readln; End.

Ề Ơ Ả Ọ Ố Ắ

ượ ử ụ ể ả ươ ả ấ ế ậ ơ ạ ố ế ộ ớ ọ ng pháp mã hoá thông tin đ vòng s lo i thi tin h c Qu c t ộ ả c s d ng r ng rãi đ đ m b o tính ch t an toàn, b o m t ề , có bài toán v mã BW đ c p t ấ ậ ề ậ ớ i m t cách ti p c n m i ầ ậ ươ ụ ề ả **9/ (BURROWSWHEELER CODE, T T: BWCODE, Đ S KH O OLYMPIC TIN H C QU C T ). Ế ề Có nhi u ph ữ ệ Ở d li u. ậ ỹ trong k thu t mã hóa và gi ư ng pháp m t mã nh sau: ví d ta c n i mã. Burrows Wheeler đ xu t ph

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ừ ướ BANANA, các b ế c ti n mã hoá t hành là:

ượ ị ể ậ ộ ự ạ c d ch chuy n vòng tròn và t o thành m t ma tr n L*L ký t , trong đó L là ủ ừ . Ta có:

ừ ầ ướ B c 1: T c n mã hoá đ ộ đ dài c a t BANANA ANANAB NANABA ANABAN NABANA ABANAN

ế ạ ướ ắ ủ ậ B c 2: S p x p l i các dòng c a ma tr n theo th t ứ ự ừ ể t đi n:

ABANANANABANANANABBANANANABANANANABA

ể ướ t t g c là t ủ ừ ố ự ế ừ ố ị m i dòng, hi n th xâu này và cho bi ầ ạ ặ c 2 (t c là c n t o c p (st,d): stxâu đã mã, 4: index c a t ừ ứ ấ th m y g c trong xâu ướ ừ mã BURROWS WHEELER. D i đây là CODE. Ố ở ỗ ộ ừ CU I các ký t ậ ượ ở ướ ứ b c đi n. Ta có (NNBAAA,4) là t

ạ B c 3: T o m t xâu t ậ trong ma tr n nh n đ ắ ừ ể đã s p t Program BW_code; Uses Crt; Var n:integer; id:Array[0..256] of integer;

Procedure Doichoid(i,j:integer); Var t:integer; Begin t:=id[i]; id[i]:=id[j]; id[j]:=t; End;

Function So(Var s:string; i,j:integer):integer; Var k: integer; Begin For k:=1 to n do Begin If (s[i]<>s[j]) Then Begin If s[i]

i:=(i MOD n)+1;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

j:=(j MOD n)+1; End; So:=0; End;

Procedure NoibotXep(Var s: string); Var i,j:integer; Begin For i:=1 to n do id[i]:=i; For i:=1 to n1 do For j:=n downto i+1 do If So(s,id[j],id[j1]) < 0 then Doichoid(j,j1); End;

Procedure BW_CREATE(Var s:string; Var u: string; Var d:integer); Var i:integer; Begin N:=length(s); NoibotXep(s); u:=' '; For i:=1 to n do Begin u:=u+s[(id[i]1+n1) MOD n+1]; If id[i]=1 then d:=i; End;

End;

Procedure Bs(var u:string); Var i,j:integer; Begin For i:=1 to n do id[i]:=i; For i:=1 to n1 do For j:=n downto i+1 do If u[id[j]]

Procedure DECODE(Var u:string; d:integer; Var s:string); Var i:integer; Begin n:=length(u); BS(u); s:=' '; d:=id[d]; For i:=1 to n do Begin s:=s+u[d];

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

d:=id[d]; End; End;

ộ ẳ ầ ả ể ứ ứ ườ ộ ằ ể ư ự ấ ằ ộ ữ ậ ớ ứ ộ ấ ể ễ ộ ượ ấ ấ ồ ằ ư ề ộ ả ữ ộ ộ ấ ỗ ư ấ ể ượ ữ ậ ớ ỉ ệ ở ủ ọ ộ ứ ữ ở c mã hóa b i các ch ể ứ ở ỉ ướ ả ủ i cùng ph i c a hcn đó.

ấ

ộ

ộ ữ ộ ỗ ộ ể

ộ i ta c n tìm m t m nh đ t hình ch nh t l n nh t b ng ph ng (t c là ch a các đi m có đ **10/ Ng ể cao b ng nhau) thu c m t vùng đ t g gh (ch a các đi m có đ cao không nh nhau) đ xây d ng sân ộ ả ồ bay. Vùng đ t đó đ c bi u di n b ng m t b n đ là m t b ng vuông c p m.n ch a các dòng có đ dài ộ ủ ườ nh nhau và m i dòng có không quá 70 ch cái th ng. Đ cao c a các đi m đ ượ ữ cái. Đ cao nh nhau đ c mã hóa b i cùng m t ch cái. Hãy tìm hình ch nh t l n nh t ch a các đi m ữ ậ ằ ộ có đ cao b ng nhau: in ra di n tích c a hình ch nh t này, t a đ các đ nh góc trên cùng trái và đ nh góc d Test. Vào: Data c t trên file CNMAX.IN có n i dung sau: 20  s các ch cái (mã) thu c m i dòng ố bcccddddeabcvvvvvvvb  mã hóa đ cao các đi m thu c vùng bbbbbccccccccccbbbbb vvvvvcccccccccccccbb vvcccccccccccccbbbbb pppppccccccccccabbbb pppppcccccccccczzzzz ssccccccccccccczzzzz sssssccccccccccccczz hhhhhcccccccccczzzzz uuuuuuuuczzzzzzzzzzz

Ra CNMAX.OU 80 2 9 6 15

CODE. Uses Crt; Const fi='CNMAX.IN'; fo='CNMAX.OU'; mn=80; {Do dai toi dai cua xau ky tu} Var f,g:Text; ten:string[12]; m:Byte; {Chieu rong manh dat} d:Longint; { Dem so dong} x,y:String; {Theo thu tu: dong tren va dong duoi} h:Array[0..mn] of Longint; { chieu cao ca cot} dtmax:Longint; { Dien tich max} axmax, cxmax:Longint; aymax, cymax:Byte; {Toa do diem a,c}

Procedure Ghi; Begin Assign(g,fo); Rewrite(g);

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Writeln(g,dtmax); Writeln(g,axmax,#32,aymax); Writeln(g,cxmax,#32,cymax); close(g); end;

Function Dientich(i:Byte; Var c1,c2: Byte):Longint; Begin c1:=i; While (y[c11]=y[i]) And (h[c11]>=h[i]) Do Dec(c1); c2:=i; While (y[c2+1]=y[i]) And (h[c2+1]>=h[i]) Do Inc(c2); Dientich:=h[i]*(c2+1c1); End;

Procedure Run; Var i,c1,c2:Byte; dt:Longint; Begin Write('Cho biet ten tep chua data vao:'); Readln(ten); Assign(f,ten); Reset(f); Readln(f,m); d:=0; x:=#32; For i:=1 to m Do x:=x+#32; FillChar(h, sizeof(h),0); While Not Eof(f) Do Begin Readln(f,y); Inc(d); For i:=1 to m Do If y[i]=x[i] then Inc(h[i]) Else h[i]:=1; For i:=1 to m Do Begin dt:=Dientich(i,c1,c2); If dt>dtmax Then Begin dtmax:=dt; axmax:=dh[i]+1; aymax:=c1; cxmax:=d; cymax:=c2; End; End; x:=y; End; Close(f); Ghi; End;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Procedure Xem; Var g:Text; Line:String; Begin Writeln('KET QUA CHAY CHUONG TRINH:'); Writeln('* * * * * * * * * * * * *'); Writeln; Assign(g,'CnMax.Ou'); Reset(g); While Not SeekEof(g) Do Begin Readln(g,Line); Writeln(#32:7,Line); End; Close(g); End;

PH N V. (RECURSION & BACKTRACKING)

Ủ Ụ

Ặ

Ế

Ệ

Ả

VI T CÁC HÀM HO C TH T C Đ QUY GI

I CÁC BÀI TOÁN SAU:

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ớ ấ ể ụ ướ ố ố ủ ố ọ ừ bàn phím vào.

1/ Tìm c s chung l n nh t (USCLN) ủ c a 2 s . Áp d ng đ tìm USCLN c a n s đ c t CODE: Program uscln; Uses crt; Var i,n,uc,tt:Integer; a:array[1..1000] of integer;

Function uscmax(x,y:integer):integer; Begin If (y=0) Then uscmax:=x Else uscmax:=uscmax(y,x MOD y) End;

Begin clrscr; Randomize; Repeat Write('Ban can bao nhieu so?:'); Readln(n); For i:=1 to n do a[i]:=Random(100); {Begin Writeln('So thu ',i,':'); Readln(a[i]); End;} Writeln('Day so vua nhap:'); For i:=1 to n do Write(a[i]:3); i:=1; Repeat uc:=uscmax(uc,a[i]); Inc(i); Until i=n+1; Writeln; Write('Uoc so chung lon nhat cua ',n,' so vua nhap=',uc); Writeln; Write('More (1/0)?. More>go 1; Stop>go 0:'); Readln(tt); Until tt=0; End.

Ả ố ọ ừ ủ ẻ C DÙNG M NG). Tìm USCLN c a 5 s đ c t ơ bàn phím vào. (Bài này có v khó h n ớ ƯỢ ộ ố ọ

2/ (KHÔNG Đ bài trên v i m t s h c sinh!) CODE: Program uso; Uses crt; Var a,b,c,d,e,uc1,uc2,uc3,uc1a,uc1b:integer; Function ucln(x,y:longint):longint; Begin if y=0 then ucln:=x Else ucln:=ucln(y,x MOD y);

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

End; Begin clrscr; Write('Nhap 5 so a,b,c,d,e:'); Readln(a,b,c,d,e); uc1:=ucln(a,b); uc2:=ucln(c,d); uc3:=ucln(e,uc2); uc1a:=ucln(uc1,uc2); uc1b:=ucln(uc1a,uc3); Write('Usc lon nhat cua 5 so vua nhap:',ucln(a,b)); Readln; End.

(cid:0) ộ ố ươ ọ ừ ồ ụ c m t s nguyên d ữ ố ng g m n ch s (n>=2) đ c t bàn phím vào. Ví d 2017 đ o ả

ả ượ 3/ Đ o ng ượ ng c thành 7102 CODE: Program Dao_so; Uses crt; Var n:longint;

Procedure Daoso(so:longint); Var csdv,caccscl:integer; Begin If (so<10) then Write(so) Else Begin csdv:=so MOD 10; {xac dinh chu so hang don vi} caccscl:=so DIV 10; {xac dinh cac chu so con lai} Write(csdv); Daoso(caccscl); End; End; Begin clrscr; Writeln; Write('Nhap vao mot so nguyen duong:'); Readln(n); Write('So ',n,' viet nguoc lai la:'); Daoso(n); Readln; End.

ị ề ứ Ổ Ế ố

4/ (DÃY FIBONACCI N I TI NG). Hai bài thú v v dãy này: 4.1 Tìm và in lên màn s Fibonacci th k. CODE: Program So_Fibonacci_thu_K; USES CRT; Var K:Longint; tt:Byte; FUNCTION Fibo(m:Longint):Longint; Begin If ((m=1) Or (m=2)) Then

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Fibo:=1 Else Fibo:=Fibo(m1) + Fibo(m2); End; BEGIN CLRSCR; Repeat Writeln('TIM SO FIBONACI THU K'); Writeln(''); Write('Nhap so K= ');

Readln(K); Writeln('So Fibonacci thu ',k,' = ',Fibo(K)); Writeln; Write('More (1/0)?. Come on > Press 1; Stop > Press 0:'); Readln(tt); Until tt=0; END.

ướ ộ ộ ướ c đ dài n. Tìm và in lên màn dãy Fibonacci có đ dài n cho tr c.

4.2 Cho tr CODE: Program Fibo; Uses crt; Var i,n: longint; Function Fibona(i: longint): longint; Begin if (i<3) then fibona:=1 Else Fibona:=Fibona(i1)+Fibona(i2); End;

Begin clrscr; Write('n='); Readln(n); Write('Day Fibonaci can tim ung voi do dai cho truoc ',n,' la:'); For i:= 1 to n do Write(Fibona(i):6); Readln End.

ọ ừ ể ấ ị gi a (n đ c t bàn ỗ ở ữ ậ ể ơ ể ượ ọ c c a cách y chuy n n đĩa có l c dùng c c trung gian 3 trong quá trình chuy n. Lu t ch i:

(cid:0)

(cid:0) ấ ứ ặ ằ ế ề ặ ượ ặ c đ t đĩa trên b t c m t b ng nào (m t bàn, gh , n n nhà . . .). ướ ủ Ệ 5/ Dùng Đ QUY, tìm cách và hi n th các b ừ ọ ọ c c 1 sang c c 2 đ phím vào) t (cid:0) M i l n ch đ ỉ ượ ể ỗ ầ c chuy n 1 đĩa, ớ ỏ ở trên đĩa l n, Đĩa nh ể Khi chuy n không đ

CODE: Uses Crt; var n, count:integer; hoi:char;

Procedure Move(n,c1,c2,c3: integer); Begin

8 h 54 m 28/7/2017

+ + *8.5 S(n)= ố ự trong đó x là s th c x + + ... x n x 2! x 3! !

ế ư ở ể ệ ấ ậ ứ ế ổ bi u th c đã cho, thì hãy bi n đ i toán ể ấ c đ quy. ượ ệ ạ ệ ẻ ư ế ạ ổ ệ ứ ạ Ợ G I Ý: N u nh tho t nhìn, không th y quy lu t dùng đ quy ứ ọ h c nó sao cho xu t hi n bi u th c dùng đ ẳ ấ ớ Ch ng h n bài 8.5 có v khó nh t v i các b n. Ta bi n đ i nó nh sau: a) Nhìn vào h th c (8.5) ta suy ra:

- - + + + x + + ... S(n1) = - - x n x n x 2! x 3! ( ( 2)! 1)!

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

- - + + + x + + ... S(n2) = - - x n x n x 2! x 3! ( ( 3)! 2)!

nx n !

ệ ượ b) Tính hi u S(n) – S(n1) ta đ c S(n) = S(n1) + (*)

(

)

- - - ệ ượ c) Tính hi u S(n1) – S(n2) ta đ c (**) S n ( 1) S n ( = 2) x n x n !

ậ ể ế ế ế ệ Th (**) vào (*) ta có ngay quy lu t đ thi t k đ quy tính S(n):

)

(

ậ ệ ệ S n ( - + 1) S n ( 2) S(n) = S(n1) + quy lu t đ quy đã hi n rõ! (cid:0) x n

ệ ạ ế ệ ễ ố ớ ạ Vi c còn l i (vi t code tính S(n)) là vi c d đ i v i các b n!

ệ ấ ả ọ ừ ị 9 Li t kê t t c các dãy nh phân dài n (n đ c t bàn phím vào).

Uses Crt; Var i,n:integer; b:Array[1..100] of 0..1; tt:byte;

Procedure Result; Var i: Integer; Begin For i:=1 to n Do Write(b[i]:2); Writeln; End;

Procedure Try(i:Integer); Var j:Integer; Begin For j:=0 to 1 do Begin b[i]:=j; If i=n Then Result Else Try(i+1); End; End;

Begin clrscr; Repeat Write('Nhap n:'); Readln(n); Try(1); Writeln;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

90 Write('Another Test (1/0)?. Come

on > Press 1, Stop > Press 0:'); Readln(tt); Until tt=0; End.

ế

Th y Tr n Thông Qu

z:=j1; End; End;

ư Begin clrscr; Write('Vao n='); Readln(n); For i:=1 to n do Begin Write('a[',i,']='); Readln(a[i]); End; dem:=0; z:=1; For i:=1 to n do p[i]:=true; Thu(1); Writeln; Writeln('Voi so n=',n,' vua nhap vao, so tap con =',dem); Readln { không có “;” cũng nh có “;” } End.

ạ ậ ộ ừ ừ ữ ế ấ có t 2 đ n 4 ch cái (trong đó có ít nh t ữ ộ ộ ế ủ ư *13Cho b 9 ch cái a, b, c, d, e, f, g, h, i. L p trình t o các t 1 nguyên âm) thu c b trên. K t q a l u lên text file cactu.ou

Uses Crt; Const chucai=['a','e','i']; fo='cactu.ou'; Var c:ArrAy[1..5] Of Char; yes:Boolean; dem, n:longint; f:text;

Procedure WriteTo; Var i:integer; Begin {Inc(dem);} For i:=1 to n Do Write(f,c[i],' '); Writeln(f); End;

Procedure Tim(i:Integer); Var ch:char; nho:Boolean; Begin Nho:=yes; For ch:='a' to 'i' do Begin c[i]:=ch; If ch In chucai then yes:=True; If (i=n) Then Begin

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

If yes then WriteTo

End Else Tim(i+1); yes:=nho; End; End;

Begin clrscr;

{Dem:=0;} Assign(f,fo); Rewrite(f); For n:=2 to 4 do Begin yes:=False; Tim(1); End; {Writeln(f,'So tu da liet ke=',dem);} Close(f); Write('Done!'); Readln; End.

ờ ướ ế ể ượ ỗ ầ ng 8x8 đ không quân nào ăn đ ầ c nào. Yêu c u: M i l n ừ ế 14/ Tìm cách x p 8 quân xe lên bàn c t ả ộ xem t ng k t qu m t. Xem ti p gõ ENTER; Thoát gõ CTRLECS.

ế Uses Crt; Const fo='tamxe.ou'; Var f:Text; d:word; line:string; cx:Array[1..8] Of Boolean; a:Array[1..8] of Byte;

Procedure WriteOnFile; Var i:Byte; Begin Inc(d); Writeln(f); Write(f,'cachh thu ',d,':'); For i:=1 to 8 do Write(f,'[',i,',',a[i],']',';'); End;

Procedure Try(k:Byte); Var i:Byte; Begin For i:=1 to 8 do If cx[i] Then Begin a[k]:=i;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

cx[i]:=False;

If k=8 then WriteOnFile Else Try(k+1); cx[i]:=True; End; End;

Begin Clrscr; d:=0; FillChar(cx,sizeof(cx),True); Assign(f,fo); Rewrite(f); Try(1); Reset(f); While Not SeekEof(f) Do Begin Readln(f,line); Writeln(#32:7,line); If (d MOD 20)=0 Then Readln; {De xem tung dap so mot; Go CTRLESC: Thoat} End; Close(f); Readln; End.

= = = = = = = = = = = = = = = = = =

Ầ

Ả

Ệ

PH N VI.

B N GHI & T P (RECORD and FILES)

ệ

ậ

L p trình làm các vi c sau:

RECORD

ệ

ố ự 1/Th c hi n các phép toán trên hai phân s . Uses Crt; Type phanso=Record ts,ms:Integer; End; Var ps1,ps2,ps3:phanso; pheptoan,tiep: char; err: Boolean;

Procedure Nhap(Var ps:phanso); Begin

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Write('Nhap tu:');Readln(ps.ts); Write('Nhap mau:');Readln(ps.ms); End;

ế

Th y Tr n Thông Qu

Var a,b,c:dathuc; i:integer; Procedure Nhap(kh:String; var p:dathuc); Begin Writeln; Writeln; With p do Begin Repeat Write('Nhap vao lan luot bac ',Chr(Ord(kh[1])+7), ' va cac he so cua da thuc ',kh,'='); Readln(bac); If bac>max Then Write('Bac cua da thuc phai <=max)',max); Until (Bac>=1) And (Bac<=max); For i:=bac downto 0 Do Begin Write(#32:3,'a[',i,']='); Readln(hso[i]); End; End; End;

Procedure PolyDisp(kyhieu:string; p:dathuc); Begin Write(kyhieu,'='); With p do Begin For i:=bac downto 1 Do Begin If hso[i]<>0 Then Begin If Frac(hso[i])=0 Then Write(hso[i]:0:0,'.x') Else Write(hso[i]:0:2,'.x'); If i>1 then Write('^',i); End; If hso[i1]>0 Then Write('+'); End; If hso[0]<>0 Then If Frac(hso[0])=0 Then Write(hso[0]:0:0) Else Write(hso[0]:0:2); End; Writeln;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

End;

Procedure PolyAdd(p,q:dathuc; Var sum:dathuc); {cong da thuc} Var i,j:integer; Begin If p.bac>q.bac Then sum.bac:=p.bac Else sum.bac:=q.bac; For i:=sum.bac downto 0 Do sum.hso[i]:=p.hso[i]+q.hso[i]; Write('Tong cua 2 d/thuc f(x) va g(x) la:'); Polydisp('S(x)',sum); End;

Procedure PolySubt(p,q:dathuc; Var h:dathuc); {tru da thuc} Var i,j:integer; Begin If p.bac>q.bac Then h.bac:=p.bac Else h.bac:=q.bac; For i:=h.bac downto 0 Do h.hso[i]:=p.hso[i]q.hso[i]; Write('Hieu cua 2 d/thuc f(x) va g(x) la:'); Polydisp('H(x)',h); End;

Procedure PolyFact(p,q:dathuc; Var tic:dathuc); {nhan da thuc} Var i,j:integer; Begin tic.bac:=p.bac+q.bac; For i:=0 to tic.bac do tic.hso[i]:=0; For i:=p.bac downto 0 Do For j:=q.bac downto 0 Do tic.hso[i+j]:=tic.hso[i+j]+p.hso[i]*q.hso[j]; Write('Tich cua 2 dthuc f(x) va g(x) la:'); Polydisp('T(x)',tic); End;

Procedure PolyDivi(p,q:dathuc; Var thg:dathuc); {chia da thuc} Var i,j,m:integer; du:dathuc; Begin m:=p.bacq.bac;

100

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

If m<0 Then Begin Write('Khong chia duoc!'); Readln; Exit; End; For i:=0 to m Do thg.hso[i]:=0; thg.bac:=m; For i:=m Downto 0 Do Begin thg.hso[i]:=p.hso[p.bac]/q.hso[q.bac]; For j:=q.bac downto 0 Do p.hso[p.bacq.bac+j]:=p.hso[p.bacq.bac+j]thg.hso[i]*q.hso[j]; p.bac:=p.bac1; End; du:=p; While (du.hso[du.bac]=0) and (du.bac>0) Do du.bac:=du.bac1; Write('Thuong cua 2 dthuc f(x) va g(x) la:'); PolyDisp('Th(x)',thg); If (du.bac=0) then Write('2 dthuc da cho chia het nhau!') Else Polydisp('Da thuc du',du); End; {Main Prog} Begin clrscr; Nhap('f(x)',a); Nhap('g(x)',b); Writeln('Cac da thuc vua nhap:'); PolyDisp('f(x)',a); PolyDisp('g(x)',b); Writeln; PolyAdd(a,b,c); Writeln; PolySubt(a,b,c); Writeln; PolyFact(a,b,c); Writeln; PolyDivi(a,b,c); Readln; End.

101

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ự

ố ứ

ề

ớ

ọ

ứ

ấ

ố ệ 3/Th c hi n các phép toán trên hai s ph c. (V i nhi u h c sinh, phép tính chia hai s ph c là khó nh t!)

Uses Crt; Type complex=Record thuc,ao:Real; End;

Var a,b,c: complex;

Procedure Input(kt: Char; Var x: complex); Begin Writeln('Nhap so phuc ',kt,':'); Write('Phan thuc:'); Readln(x.thuc); Write('Phan ao:'); Readln(x.ao); End;

Procedure WriteCompl(x:complex); Begin Write('('); If Frac(x.thuc)=0 then Write(x.thuc:0:0) Else Write(x.thuc:0:2); Write(';'); If Frac(x.ao)=0 then Write(x.ao:0:0) Else Write(x.ao:0:2); Write(')'); End;

Procedure Add(x,y:complex; Var z:complex); Begin z.thuc:=x.thuc+y.thuc; z.ao:=x.ao+y.ao; End;

Procedure Sub(x,y:complex; Var z:complex); Begin z.thuc:=x.thucy.thuc; z.ao:=x.aoy.ao; End;

Procedure Multip(x,y:complex; Var z:complex);

102

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Begin z.thuc:=x.thuc*y.thucx.ao*y.ao; z.ao:=x.thuc*y.ao+x.ao*y.thuc; End;

Procedure Divi(x,y:complex; Var z:complex); Begin z.thuc:=(x.thuc*y.thuc+x.ao*y.ao)/(sqr(y.thuc)+sqr(y.ao)); z.ao:=(x.ao*y.thucx.thuc*y.ao)/(sqr(y.thuc)+sqr(y.ao)); End;

Begin clrscr; Input('A',a); Input('B',b); clrscr; Writeln('Hai so phuc vua nhap la:'); Writeln; Write('So phuc A:'); WriteCompl(a); Writeln; Write('So phuc b:'); WriteCompl(b); Writeln; Add(a,b,c); Write('Tong 2 so phuc vua nhap='); WriteCompl(c); Writeln; sub(a,b,c); Write('Hieu 2 so phuc vua nhap='); WriteCompl(c); Writeln; Multip(a,b,c); Write('Tich 2 so phuc vua nhap='); WriteCompl(c); Writeln; Divi(a,b,c); Write('Thuong cua 2 so phuc vua nhap='); WriteCompl(c); Readln; End.

FILES

ộ

ạ

ủ

ượ ư

i sân bay N i Bài đ

c l u trong text file tên là

ế

ố

ấ ồ

ủ ừ

ữ ệ

ủ

ồ

ỗ

ộ

ng c a t ng đ xách tay (túi, h p, balô …) c a m i khách. D li u ra g m hai

ượ

ủ

ỗ

ồ

ọ

ng các đ xách tay c a m i khách bay;

ế

ọ

103

ị ủ Ặ ố ồ

ế ổ ơ

ườ

ề

ồ

ư ậ

ộ

4/ Các thông tin Check In c a khách t ầ KHACHBAY.VAO có c u trúc sau: Dòng đ u ghi s khách bay, các dòng ti p theo ghi ượ ọ tr ng l text file: ổ file TRONGLUONG.RA ghi t ng tr ng l ố ứ ự ủ ữ c a nh ng khách bay b h y chuy n bay n u t ng tr ng file HUYBAY.RA ghi s th t ủ ượ l 20 KG HO C s đ xách tay nhi u h n 5. i này ng các đ xách tay c a ng ụ ề ướ D i đây là m t ví d v 3 files nh v y:

(cid:0)

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ấ

ỗ

ộ

ố

ự ố

tr ng)

KHACHBAY.VAO 5 19.5 2.5 1.5 2 3.25 1 3 (Trên m i dòng các s cách nhau ít nh t m t ký t 6.25 2.5 7 12 6.5 4 10 7.5 2 6 8

TRONGLUONG.RA 19.50 13.25 15.75 40.00 16.00

HUYBAY.RA →

ố ồ

khách này có s đ xách tay >5

104

Uses Crt; Var tepvao,tepra,tephuy: Text; sum,w: Real; n,i,k:Byte; Begin Clrscr; Assign(tepvao,'khachbay.vao'); Reset(tepvao); Readln(tepvao,n); Assign(tepra,'trgluong.ra'); Rewrite(tepra); Assign(tephuy,'huybay.ra'); Rewrite(tephuy); For i:=1 to n do Begin sum:=0; k:=0; While Not(SeekEoln(tepvao)) Do Begin Read(tepvao,w); sum:=sum+w; k:=k+1; End; Writeln(tepra,sum); If (sum>20) Or (k>7) Then Writeln(tephuy,i); Readln(tepvao);

2 4

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

End; Close(tepvao); Close(tepra); Close(tephuy);

Assign(tepra,'trgluong.ra'); Reset(tepra); Writeln('Noi dung cua file trgluong.ra ghi tong trongluong'); Writeln(' cac kien hang cua tung khach hang:'); Writeln; While Not(SeekEof(tepra)) do Begin Readln(tepra,sum); Writeln(sum:0:2); End; Close(tepra); Writeln; Assign(tephuy,'huybay.ra'); Reset(tephuy); Writeln('Noi dung tep huybay.ra ghi so thu tu cac khach bi huy bay:'); Writeln; While Not(SeekEof(tephuy)) do Begin Readln(tephuy,i); Writeln(i); End; Close(tephuy); Readln; End.

ồ

ả ố ươ

ẫ ố

ượ ư

ng l n s âm) đ

c l u trên text file

ấ

ị ộ

ể

ấ

ố

ng lên file POSI.DAT, c t các s âm lên fie NEGA.DAT. Hi n th n i

ố 5/ Các s nguyên (g m c s d SONGUYEN.DAT, ố ươ Hãy c t các s d dung hai file này lên màn hình.

Program PosiNegaFile; Uses Crt; Var f1,f2,f3: file Of Integer; i,n,x:integer; Begin clrscr; {$I} Assign(f1,'Songuyen.dat'); Rewrite(f1); {$I+} Write('Cho so luong cac so nguyen:'); Readln(n);

105

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

For i:=1 to n do Begin Write('So thu ',i,':'); Readln(x); Write(f1,x); End; Close(f1); Write(#10#13,'Da nhap xong ',n,' so nguyen len file songuyen.dat'); Writeln('Press Any Key to Continue...'); Repeat Until KeyPressed; Readkey; Clrscr; {$I} Assign(f1,'Songuyen.dat'); Assign(f2,'Posi.dat'); Assign(f3,'Nega.dat'); Reset(f1); Rewrite(f2); Rewrite(f3); {$I+} {Ghi cac so Duong len File f2, ghi cac so am len file f3} While Not EOF(f1) Do Begin Read(f1,x); If (x>=0) Then Write(f2,x) Else Write(f3,x); End; Close(f1); Close(f2); Close(f3); {Doc Data cua file f2} Assign(f2,'Posi.dat'); Reset(f2); Writeln('Data tren file Posi.dat:'); While Not EOF(f2) Do Begin Read(f2,x); Write(x:3); End; Close(f2); Writeln; { Doc Data tren file f3} Assign(f3,'Nega.dat'); Reset(f3); Writeln('Data tren file Nega.dat:');

106

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

While Not EOF(f3) Do Begin Read(f3,x); Write(x:3); End; Close(f3); Write(#10#13,' Press Any Key to continue...'); Repeat until KeyPressed; End.

ứ

ộ ố ố

ứ

ặ ở ả

ố ư

ặ

ố

c hai file trên và

ệ

ộ ố ố 6/Text file Num1.txt ch a m t s s nguyên; text file Num2.txt cũng ch a m t s s nguyên. Hai files này có vài s nh nhau. Tìm và “nh t” các s có m t ộ ư l u chúng lên file Ketqua.txt. Hi n n i dung file Ketqua.txt lên màn hình.

Uses Crt; Var f1,f2,f3: Text; m,n,i,j,x:Integer; a1,a2:Array[1..100] of Integer; Begin clrscr; {$I} Assign(f1,'Num1.txt'); Assign(f2,'Num2.txt'); Rewrite(f1); Rewrite(f2); {$I+} Write('Cho so cac so trong file Num1.txt:'); Readln(m); Writeln(f1,m); For i:=1 to m do Begin Write('So thu ',i,':'); Readln(x); Writeln(f1,x:3); End; Close(f1); Write('Cho so cac so trong file Num2.txt:'); Readln(n); Writeln(f2,n); For i:=1 to n do Begin Write('So thu ',i,':');

107

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Readln(x); Writeln(f2,x:3); End; Close(f2); {$I} Assign(f1,'Num1.txt'); Assign(f2,'Num2.txt'); Assign(f3,'Ketqua.txt'); Reset(f1); Reset(f2); Rewrite(f3); {$I+} {Doc Data tren file f1 vao mang a1 (tuc vao Ram)} Readln(f1,m); For i:=1 to m do Readln(f1,a1[i]); {Doc Data tren file f2 vao mang a2 (tuc vao Ram)} Readln(f2,n); For j:=1 to n do Readln(f2,a2[j]); Writeln; Writeln('CAC SO CO MAT O CA 2 FILE:'); Writeln; For i:=1 to m do For j:=1 to n do Begin If a1[i]=a2[j] Then Begin Writeln(f3,a1[i]:3); Writeln(a1[i]:3); End; End; Close(f1); Close(f2); Close(f3); Write(#10#13,'GO PHIM BAT KY DE TIEP...'); Repeat Until KeyPressed; End.

108

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

= = = = = = = = = = = = = = = = = = =

109

Ầ

Ồ Ọ

PH N VII.

Đ H A (GRAPHIC)

ị ớ

ữ

ấ

ườ

(Ít nh t cũng có 5 bài khá thú v v i nh ng ng

ậ i mê l p trình:

ị

ồ

ệ

ạ Ấ Ả

ẽ ồ ặ ậ

Ệ

ể

ặ ậ

ủ Ộ đó là các bài: In l ch; V đ ng h ; Kính v n hoa; Tìm M T nghi m c a bài toán Đ t H u; Tìm T T C NGHI M có th cho bài toán Đ t H u)

ờ ữ Ả Ấ Ả Ề Ỗ Ợ Ạ Ả Ế Ế Ờ Ặ Ừ L i khuyên h u ích: T T C CÁC BÀI TOÁN GRAPHIC VÀ GRAPH DÙNG GRAPHIC Đ U PH I CH Y TRONG CÁC PHIÊN B N WINDOW CÓ H TR FULL SCREEN MODE. Đ N CH T CŨNG Đ NG QUÊN L I D N NÀY!!!

ồ ọ ậ ự L p trình Đ h a th c thi các bài toán sau:

ẽ ộ ề 1/ V c t phát sóng và các vòng sóng truy n lan.

Uses Crt, Graph; Var Gd, Gm: Integer; r:word;

Begin clrscr; Gd:=Detect; InitGraph(Gd,Gm,'D:\BP\BGI'); r:=15; Repeat SetColor(4); MoveTo(300,200); LineTo(320,440); LineTo(280,440); LineTo(300,200); Rectangle(280,440,320,470); SetColor(15); Circle(300,200,r); Delay(100); If r>GetmaxY/2 then ClearDevice; If r<=GetmaxY/2 then r:=r+30 Else r:=15; Until KeyPressed; CloseGraph; End.

ụ ẽ ồ ổ 2/ V các vòng tròn đ ng tâm đ i màu liên t c.

8 h 54 m 28/7/2017

PROCEDURE BINARY(X,Y:REAL;VAR C:CODE); Begin c:=[]; If xxdfen then c:=[r]; If yYhFen then c:=c+[h] End; BEGIN

binary(x1,y1,c1); binary(x2,y2,c2); WHILE (c1<>[] ) or (c2<>[])do

BEGIN if (c1*c2)<>[] then exit; if c=[] then c:=c2 else c:=c1; if l in c then begin x:=xgFen;

8 h 54 m 28/7/2017

ầ

Repeat ktdohoa; CuaSo(1,1 ,1,1); TamNhin(160,maxx160,75,maxy75); Ve(sotg,kc,lap); TamNhin(0,maxx,0,maxy); rectangle(1,1,maxx1,maxy1); rectangle(5,5,maxx5,maxy5); setcolor(yellow); settextjustify(1,1); settextstyle(1,0,4); outtextxy(maxx div 2,20,' VE KINH VAN HOA '); outtextxy(maxx div 2,45,' ************************ '); settextstyle(1,0,1); setcolor(lightblue); outtextxy(maxx div 2,maxy20,' Go ESC de thoat, Go phim BAT KY de tiep tuc !'); settextstyle(2,1,8); outtextxy(20,maxy div 2,'Thay: TRAN THONG QUE'); outtextxy(maxx24,maxy div 2,'COPYRIGHT (C) 1994'); repeat until KeyPressed; ch:=readkey; if ch=#27 then begin cleardevice; closegraph; halt; end; closeGraph; nhapsolieu; Until ( Sotg=0); END.

Ả Ề Ặ Ả Ề Ỹ Ậ Ậ Ấ CÁC BÀI 7, 8, 10, 11 R T KHÓ C V M T THU T TOÁN VÀ C V K NĂNG L P TRÌNH!!!

ạ ạ ủ ế ắ ồ ồ ị ầ **7/ T o đ ng h có 3 kim+ti ng tích t c kêu theo nh p ch y c a kim giây. Và thêm các yêu c u sau: ả ấ ỳ ể ổ ề ờ ệ ệ ả ờ ứ ạ ả ồ ố ố và kim phút có d ng hình t ệ giác. (gi

a Dòng trên cùng phía ph i màn hình có dòng chũ: “Gõ phím b t k đ ồ đ i màu đ ng h và n n màn hình. b Dòng cu i cùng phía trái màn hình hi n th i gian hi n hành. ệ c Dòng cu i cùng phía ph i màn hình hi n ngày tháng năm hi n th i. ờ d Kim gi hình thoi Quasi Lozenge) program Draw_Clock; uses crt,GRAPH,dos; const color:array[0..15] of byte=(8,7,3,15,6,14,10,4,2,9,1,12,5,0,13,11); var m,co:byte;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

123

col:set of 0..15;

r,xt,yt:word; e:char; st:string[10];st1,st2,st3:string[4];

{}

procedure init; var gd,gm:integer; begin gd:=0; initgraph(gd,gm,'..\bgi'); if graphresult<>0 then halt;m:=1;e:=#2; end;

{}

procedure draw_frame; const number:array[1..12] of string[2]=('1','2','3','4','5','6','7','8','9','10','11','12'); dayofweek:array[0..6]of string[3]=('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); var i,x,y,year,month,day,day_of_week:word; begin xt:=getmaxx div 2;yt:=getmaxy div 2; r:=yt10; settextjustify(1,1); {ve duong vien ngoai cung:} setcolor(color[13]); setlinestyle(0,0,3); rectangle(1,1,getmaxx,getmaxy); rectangle(3,3,getmaxx2,getmaxy2); {ve duong tron bao dong ho:} for i:= 0 to 6 do circle(xt,yt,r+3i); {to mau nau khoang trong:} m:=(m mod 2)+1; if odd(m) then co:=1 else co:=1+(color[13] mod 11); setfillstyle(co,color[4]); floodfill(xt+r20,yt+r20,color[13]); setfillstyle(1,color[3]); floodfill(xt,yt,color[13]); setcolor(color[1]); setlinestyle(0,0,3); rectangle(1,1,getmaxx,getmaxy); rectangle(3,3,getmaxx2,getmaxy2); setfillstyle(1,color[1]);

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

124

bar(0,getmaxy

15,getmaxx,getmaxy); setfillstyle(solidfill,color[13]); bar(80,getmaxy15,getmaxx80,getmaxy); {hien ngay thang nam o dong duoi cung phai man hinh:} setfillstyle(solidfill,color[8]); bar(8,getmaxy50,170,getmaxy20); bar(getmaxx170,getmaxy50,getmaxx8,getmaxy20); setfillstyle(1,color[11]); bar(getmaxx150,60,getmaxx10,70); getdate(year,month,day,day_of_week); str(day,st1); str(month,st2); str(year,st3); if day<10 then st1:='0'+st1; if month<10 then st2:='0'+st2; {settextstyle(4,0,6); setcolor(color[5]); outtextxy(getmaxx80,25,st3); settextstyle(4,0,4); setcolor(color[6]); outtextxy(120,20,' Happy New Year !'); } settextstyle(0,0,2); setcolor(color[7]); for i:=0 to 1 do outtextxy(40+30*i,60,chr(i+3)); setcolor(color[15]); for i:=2 to 3 do outtextxy(40+30*i,60,chr(i+3)); st:=' ';st:=dayofweek[day_of_week]+','+st1+'.'+st2; settextstyle(0,0,2); setcolor(color[9]); outtextxy(getmaxx90,getmaxy35,st); settextstyle(2,0,1); setusercharsize(2,3,1,1); setcolor(color[10]); outtextxy(getmaxx80,63,' * Press any key to change color...'); {trang tri ben trong dong ho:} settextstyle(0,0,1); setcolor(color[11]); for i:=1 to 60 do begin x:=xt+round((r20)*sin(i*pi/30)); y:=ytround((r20)*cos(i*pi/30)); if(i mod 5)<>0 then outtextxy(x,y,chr(1)) end; settextstyle(0,0,2); for i:=1 to 12 do begin

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

125 x:=xt+round((r50)*sin(i*pi/6));

ế

Th y Tr n Thông Qu

129

Begin

nosound; delay(80);

sound(2700);delay(120); End else Begin sound(2700);

delay(1000); nosound; delay(1000);

End; setcolor(color[13]); outtextxy(getmaxx div 2,getmaxy7,copy(a[j],i,60)); change; setcolor(color[3]); Outtextxy(getmaxx div 2,getmaxy7,copy(a[j],i,60)); delay(200); setcolor(color[13]); outtextxy(getmaxx div 2,getmaxy7,copy(a[j],i,60)); change; setcolor(color[3]); outtextxy(getmaxx div 2,getmaxy7,copy(a[j],i,60)); delay(150);nb:=false; end; while keypressed do e:=readkey; until e<>#2; if e<>#27 then e:=#2; End; {} procedure set_color; var i:byte; begin randomize; col:=[]; for i:=0 to 15 do begin repeat color[i]:=random(16); if (i>=11) and (i<=14) then if (color[i]=0) and not(0 in col) then color[i]:=color[i1]; until not(color[i] in col); col:=col+[color[i]] end; end; {} procedure maker; begin clrscr;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

130

gotoxy(30,17);

TEXTCOLOR(YELLOW); write('Press any key to continue...'); window(20,10,60,15); textbackground(lightgray); clrscr; textcolor(blue); writeln; writeln(' THAY TRANTHONGQUE '); writeln; writeln(' * * * * * * * * * '); textcolor(lightgray); e:=readkey; end; begin maker; init; repeat graphdefaults; cleardevice; draw_frame; run; set_color; until e=#27; closegraph; end.

Th y Tr n Thông Qu

133

Delay(200); End Else Begin Move(n1,c1,c3,c2); Move(1,c1,c2,c3); Move(n1,c3,c2,c1); End; End; {Main prog.} Begin Clrscr; GotoXY(35,4); Write('BAI TOAN THAP HA NOI.'); GotoXY(4,YORGn+4); GotoXY(XORG[1],YORGn); Write(#179); GotoXY(XORG[1]1,YORGn+1); Write(#219#219#219); GotoXY(XORG[1]2,YORGn+2); Write(#219#219#219#219#219); GotoXY(XORG[1]3,YORGn+3); Write(#219#219#219#219#219#219#219); GotoXY(XORG[1]4,YORGn+4); Write(#219#219#219#219#219#219#219#219#219); For i:=0 to n Do Begin GotoXY(XORG[2],YORGn+I); Write(#179); End; For I:=0 to n do Begin GotoXY(XORG[3],YORGn+I); Write(#179); End; docao[1]:=n; docao[2]:=0; docao[3]:=0; For I:=1 to n do DK[I,1]:=nI+1; For I:=1 to n do DK[I,2]:=0; For I:=1 to n do DK[I,3]:=0; GotoXY(22,24); Write('Press Ctrl_C to Stop.'); GotoXY(43,4); Repeat Delay(500); Move(n,1,2,3); Delay(500); Move(n,2,3,1); Delay(500); Move(n,3,1,2); Until KeyPressed; End.

Ả

B NG TEST

Ọ Ọ Ủ Ề ườ ươ ữ ệ ầ ị Ố ng tròn. Xét các v trí t ở ớ ạ i h n b i ệ ặ ế ủ ế ể ặ ớ ở ị Ộ *9/ (M T TRONG S CÁC Đ OLYMPIC TIN H C C A H C SINH THCS 4/1994) ẳ ẽ V hai đ ườ 2 đ ng quan gi a chúng. Và tính di n tích ph n m t ph ng gi trong nhau ho c ti p súc trong v i nhau. Hi n th các k t q a tính di n tích. ng tròn khi chúng

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

134

ươ ữ CÁC TEST ị V trí t ng quan gi a hai vòng tròn ọ ộ T a đ tâm & bán kính vòng tròn Y X R

ờ Hai vòng tròn r i nhau Vòng tròn 1 Vòng tròn 2 200 50 200 50 100 30

ắ Hai vòng tròn c t nhau Vòng tròn 1 Vòng tròn 2 200 270 200 130 100 40

ế Hai vòng tròn ti p xúc ngoài Vòng tròn 1 Vòng tròn 2 200 350 200 200 100 50

Hai vòng tròn trùng khít nhau Vòng tròn 1 Vòng tròn 2 200 200 200 200 100 100

ằ ạ ủ ọ i c a vòng to=2016 tròn to. Dt còn l Vòng tròn 1 Vòng tròn 2 200 220 200 220 100 Vòng tròn tròn bé n m tr n trong vòng 60

Th y Tr n Thông Qu

Th y Tr n Thông Qu

140

rectangle(7,7,413,412); End;

Procedure Result; Var s:string[2]; i:integer; Begin setfillstyle(1,blue); bar(7,410,413,470); setcolor(red); rectangle(8,8,412,411); rectangle(7,7,413,412); settextstyle(1,0,3); setcolor(white); for i:=1 to 8 do begin str(h[i],s); outtextxy(28+(i1)*50,getmaxy50,s); end; End;

Procedure Try(i:integer;Var q:boolean); Var j:integer; Begin j:=0; repeat q:=false; inc(j); if a[j] and b[i+j] and c[ij] then begin h[i]:=j; Put_Queen((i1)*50+10,(j1)*50+10); sound(150);delay(dl);nosound; a[j]:=false;b[i+j]:=false;c[ij]:=false; if i<8 then begin Try(i+1,q); if not q then begin a[j]:=True;b[i+j]:=true;c[ij]:=true; Put_Queen((i1)*50+10,(j1)*50+10); sound(350);delay(dl);nosound; end; end else q:=true; end; until q or(j=8); End;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

141

Procedure Search; Var i:integer;ch:char; Begin for i:=1 to 8 do a[i]:=true; for i:=2 to 16 do b[i]:=true; for i:=7 to 7 do c[i]:=true; Try(1,found); if found then Result; setcolor(white); settextstyle(2,0,7); outtextxy(430,300,'Go Esc Ket Thuc !'); repeat ch:=readkey until ch=#27; End;

BEGIN Initgr; Table; Search; Closegraph; END.

ế

Th y Tr n Thông Qu

144

end; End;

Procedure Put_Queen(i,j:integer); Begin Putimage(i+2,j+2,P^,Xorput); End; {===============================} Procedure Table; Var m,n:integer; Begin setviewport(0,0,getmaxx,getmaxy,false); for m:=1 to 8 do for n:=1 to 8 do Draw(m,n); Demo; Draw_Queen(10,getmaxy65);Put_Queen(10,getmaxy65); setfillstyle(1,blue); bar(7,410,413,470); setcolor(red); rectangle(8,8,412,411);

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

145

rectangle(7,7,413,412); End;

Procedure Wait; Begin inc(t); Result; setcolor(yellow); settextstyle(2,0,6); outtextxy(430,200,'Go Phim Esc De Ngung !'); setcolor(white); settextstyle(2,0,5); outtextxy(420,230,'Go Phim Bat Ky De Tiep Tuc...'); while keypressed do ch:=readkey; repeat until keypressed; ch:=readkey; if ch=#27 then stop:=true; End;

Procedure Music; Begin sound(Mc[g][1]); delay(mc[g][2]*8);{ delay(20000);} nosound; if g=210 then g:=1 else inc(g) End;

Procedure Try(i:integer); Var j:integer;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

146

Begin j:=0; repeat inc(j); if a[j] and b[i+j] and c[ij] then begin h[i]:=j; Put_Queen((i1)*50+10,(j1)*50+10); Music; a[j]:=false;b[i+j]:=false;c[ij]:=false; if i<8 then Try(i+1) else Wait; a[j]:=True;b[i+j]:=true;c[ij]:=true; Put_Queen((i1)*50+10,(j1)*50+10); Music; end; until (j=8) or stop; End;

Procedure Search; Var i:integer; s:string[30]; Begin t:=0;g:=1; stop:=false; for i:=1 to 8 do a[i]:=true; for i:=2 to 16 do b[i]:=true; for i:=7 to 7 do c[i]:=true; Try(1); str(t,s); if stop then s:='Da Tim Duoc '+s+' Loi Giai' else s:='Tong So Co '+s+' Loi Giai'; setcolor(red); settextstyle(2,0,6); outtextxy(418,280,s); setcolor(white); settextstyle(2,0,7); outtextxy(430,310,'Go Esc Ket Thuc !'); repeat ch:=readkey until ch=#27; End;

BEGIN Initgr; Table; Search;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

147

Closegraph; END.

= = = = = = = = = = = = = = = = = = = = = =

Ầ

PH N VIII.

GRAPH THEORY & APPLICATIONS

Ồ

Ệ

Ị

Ế Ồ

Ủ

Ề

Ị

Ị VIII.1TÌM KI M TRÊN Đ TH (tên khác: DUY T Đ TH ); TÔ MÀU Đ TH ; TÌM MI N LIÊN THÔNG C A ĐT.

ế ơ ơ ề ộ ấ ề ề ấ ạ m v lý thuy t m t v n đ nào đó, các b n nên đ n th vi n – đ m t ít ti n nh t ế ầ Ồ Ụ ể ả Ị ế (N u quên OR l xem quy n: LÝ THUYÊT Đ TH , nxb GIÁO D C 2012. Tác gi ư ệ ể ấ ế : Tr n Thông Qu )

Ậ

Ế

Ệ

ậ Ư Ả ể ừ ể ậ ầ thu t toán DFS sang BFS và ng ượ ạ c l i, ể

Th y Tr n Thông Qu

150

(**) PROCEDURE VE_GR_BFS(U:CSD); {HIEN THI DO THI DE DUYET THEO BE RONG} VAR Q:QUEUE; BEGIN VENUT(U,CL[K],NL[K]); P[U]:=0; Q.REAR:=0; ADD(U,Q); WHILE Q.REAR<>0 DO BEGIN DELETE(Q,I); FOR J:=1 TO N DO IF G[I,J] THEN IF P[J]=VC THEN BEGIN P[J]:=I; LINK(I,J,NL[K]); VENUT(J,CL[K],NL[K]); VENUT(I,CL[K],NL[K]); ADD(J,Q); DELAY(DL); END; END; END;

(**) PROCEDURE BFS; {DUYET THEO CHIEU RONG} BEGIN FOR U:=1 TO N DO P[U]:=VC; K:=0; FOR U:=1 TO N DO IF P[U]=VC THEN BEGIN K:=(K+1) MOD 4; VE_GR_BFS(U);DELAY(DL) END; END; (**) PROCEDURE VE_DT_DFS(U:CSD); {HIEN THI DO THI DE DUYET THEO CHIEU SAU} VAR T:CSD; BEGIN I:=I+1; P[U]:=I; FOR T:=1 TO N DO IF G[U,T] THEN IF P[T]=0 THEN BEGIN LINK(U,T,NL[K]);

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

151

VENUT(U,CL[K],NL[K]); VENUT(T,CL[K],NL[K]); DELAY(DL); VE_DT_DFS(T); END; END; (**) PROCEDURE DFS; {DUYET THEO CHIEU SAU} BEGIN FOR I:=1 TO N DO P[I]:=0; I:=0; FOR U:=1 TO N DO IF P[U]=0 THEN BEGIN K:=(K+1) MOD 4; VENUT(U,CL[K],NL[K]); VE_DT_DFS(U);DELAY(DL) END; END; (**) PROCEDURE PROC_CALL_PROC; {THU TUC GOI CAC THU TUC DUYET} VAR KT:CHAR; BEGIN IF KEYPRESSED THEN REPEAT KT:=READKEY UNTIL NOT KEYPRESSED; REPEAT DATA_AUTO_CREA; PRINT_GRAPH; DEMO('Theo Be Rong'); KT:=READKEY; IF KT=#27 THEN EXIT; BFS; KT:=READKEY; IF KT=#27 THEN EXIT; PRINT_GRAPH; DEMO('Theo Do Sau'); KT:=READKEY; IF KT=#27 THEN EXIT; DFS; KT:=READKEY; UNTIL (KT=#27); END; (**) BEGIN (* CHUONG TRINH CHINH *) CLRSCR; INITGR; PROC_CALL_PROC;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

152

CLOSEGRAPH; END.

ử ộ ấ ở ứ Ơ Ả ệ ố ậ Ọ ự ế ươ ỳ ệ ẳ ạ ọ ư ề Th m t bài duy nh t m c TRÊN C B N v duy t theo BFS: Ố Ế ỳ ệ ng k di u, 2(IOI1996: THI OLYMPIC TIN H C QU C T 1996) Ti p theo thành t u kh i l p ph ộ ố ủ ông Rubik phát minh d ng c i biên ph ng c a kh i này và ông g i đó là các ô vuông k di u. Đó là m t ượ ả b ng 8 ô vuông có kích th c tô màu khác nhau. ả ướ c nh nhau đ

1 2 3 4

8 7 6 5

ố ở ươ ượ ề c ký hi u b i 8 s nguyên d ng đàu tiên (xem hình ngay trên) vi t theo chi u ế ầ ượ t l n l ở ế ướ i cùng trái. ầ ô góc d ệ ổ ơ ả ự ế ệ ấ ấ ủ ả

ộ ỗ ệ ổ ự ả ả

ổ ơ ả ủ ề ế ộ c tác đ ng b i 3 phép bi n đ i c b n nói trên. Và tác đ ng c a 3 phép ƯỚ Ố I ĐÂY CÁC S TRÊN CÙNG M I B DATA D ở ữ gi a ở Ở Ỗ Ộ i đây: ( Ả Ủ ị ồ ể ượ ả ở Ị ệ Các màu tô đ ồ ắ ầ ừ ồ kim đ ng h , b t đ u t ô góc trên cùng trái và k t thúc ộ ấ ọ ư M t c u hình nh trên g i là c u hình ban đ u. Ta th c hi n 3 phép bi n đ i c b n ký hi u là ‘A’, ‘B’, ể ‘C’ đ tác đ ng lên c u hình c a b ng, trong đó: ướ • ‘A’: Đ i ch dòng trên và dòng d i ề • ‘B’: Th c hi n phép hoán v theo chi u sang ph i vòng quanh b ng. ồ ề • ‘C’: Quay theo chi u kim đ ng h 4 ô ọ ấ M i c u hình đ u có th đ ổ ơ ả ấ ế bi n đ i c b n y mô t ƯỚ VÀ D ộ ướ b i hình d I CÙNG LÀ V TRÍ CÁC Ô C A B NG)

(cid:0) Ả ủ B NG 1 1 2 3 4 INDEX c a các ô

1 2 3 4

8 7 6 5

ủ INDEX c a các ô

8 7 6 5 (cid:0)

Ả B NG 2

4 1 2 3

5 8 7 6

Ả B NG 3 1 7 2 4

8 6 3 5

ứ ố ở ị ộ ỉ ị ả ổ ươ ứ ủ ả ị ể ế ị ố Các s ghi làm phép bi n đ i t ở ngoài b ng ch v trí các ô c a b ng. N u m t ô ế ế ng ng, ô vuông mà v trí tr ế v trí p ch a s i thì có nghĩa là sau khi ẽ ượ ổ ủ ướ c lúc bi n đ i c a nó là i s đ c chuy n đ n v trí

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

153

ế ề ộ ấ ướ ầ t program tìm dãy các phép bi n đ i đ đ a c u hình ban đ u v m t c u hình đích cho tr c. ể ế ố ổ ủ ạ ổ ể ư ấ ế c thêm 2 đi m n u s phép bi n đ i c a b n không quá 300 ấ ồ ả ấ ứ ấ ố c u hình đích.

ả ầ ổ ủ ạ Ự ế ệ ế ổ ạ ự p. ế a) Hãy vi ạ ẽ ượ b) B n s đ ữ ệ * D li u vào c t trên text file Data.in g m: ộ M t dòng duy nh t ch a 8 s nguyên mô t ế * K t qu ghi lên text file Data.ou: ế ố Dòng đ u tiên ghi s các phép bi n đ i L T i L dòng ti p theo ghi ký hi u các phép bi n đ i đã nói trên theo TRÌNH T mà program c a b n đã ệ th c hi n

Th y Tr n Thông Qu

156

Ậ

ƯỚ

Ề

Ị

Ề Ồ ề

NG ộ ồ ị ư

ế ằ ặ t r ng t kê các thành ph n (mi n) liên thông c a m t đ th vô h ượ ướ ng. Bi ư ướ ể ệ ễ ầ ở c bi u di n b i danh sách li t kê c nh nh sau (Ds này l u trên Text ệ ng đ Procedure Xuat; Var tepra:text; L,i:word; Begin Assign(tepra,fo); rewrite(tepra); L:=length(s); Writeln(tepra, L1); For i:=1 to L do Writeln(tepra, s[i]); Close(tepra); End; Begin {Main Prog.} clrscr; Nhap; Facto; Sinh; Tim; Xuat; Writeln('Done!'); readln; End. Ồ Ị B/ CÁC THU T TOÁN TÌM CÁC MI N LIÊN THÔNG TRÊN Đ TH B.1) TÌM MI N LIÊN THÔNG TRÊN Đ TH VÔ H ủ ậ 3 Cài đ t thu t toán tìm & li ạ ủ ồ ị ấ c u trúc c a đ th vô h File LTHG.IN):

13 10 1 2 1 3 2 3 4 5 4 7 5 6 8 9 10 12 11 12 12 13

ả ư ế K t qu l u trên file Xuat.kq

ể ạ ượ ệ ồ ị ệ ụ ề CODE: Đ đ t đ c m c tiêu đ bài ta duy t đ th Đ quy theo DFS

Program Dem_so_thp_lthong; uses crt; const max=50; fi='lthg.in'; fo='xuat.kq'; {Du lieu vao la Ds liet ke canh!} type m1=Array[0..max] of integer; m2=Array[1..max,1..max] of byte; var a:m2; {ma tran danh sach liet ke canh}

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

157

n:integer; v:m1; sm:integer; {so mien lien thong}

Procedure Nhap; var f:text; i,j:integer; Begin Assign(f,fi); Reset(f); Read(f,n); FillChar(a,sizeof(a),0); {khoi tri cho mang a} While not seekeof(f) do {tao ma tran luu dinh dau va cuoi cua moi canh} Begin Read(f,i); While not seekeoln(f) do Begin Read(f,j); a[i,j]:=1; a[j,i]:=1; End; Readln(f); End; Close(f); End;

Procedure DFS(i:integer); Var j:integer; Begin For j:=1 to n do If v[j]=0 then {neu j chua thuoc mien lien thong nao thi} If a[i,j]=1 then {neu j ke voi i thi } Begin v[j]:=sm; {ghi nho dinh j cung mien lth sm voi i} DFS(j); {duyet tiep do thi theo chieu sau tu dinh j} End; End;

Procedure Xuly; Var s:integer; Begin FillChar(v,sizeof(v),0); sm:=0; For s:=1 to n do If v[s]=0 then Begin Inc(sm); {danh so cho mien lth moi} v[s]:=sm; {s la dinh dau tien phat hien thuoc mien lth moi} DFS(s); {Duyet dthi tim tat ca cac dinh lth voi s} End; End;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

158

Procedure ghikq; var f:text; i,j:integer; Begin Assign(f,fo); Rewrite(f); Writeln(f,'So mien lien thong la:',sm); For i:=1 to sm do Begin For j:=1 to n do If v[j]=i then Write(f,j,' '); Writeln(f,'< Day la cac dinh o mien Lt thu ',i); End; close(f); End;

Ề

Ạ

Ồ

ƯỚ

Ự

Ị

NG (TH C

Ặ

Ậ

Ấ

Procedure Inkq; var f:text; line:string[50]; Begin Assign(f,fo); Reset(f); While not seekeof(f) Do Begin Readln(f,line); Writeln(line); End; Close(f); End; Begin clrscr; Nhap; Xuly; Ghikq; Inkq; Writeln; Write('Go ENTER de thoat!'); Readln; End.

B.2) TÌM MI N LIÊN THÔNG M NH TRÊN Đ TH CÓ H CH T LÀ CÀI Đ T THU T TOÁN TARJAN) ậ 4/ Cài đ t thu t toán tìm & li ồ ị ế ằ TARJAN). Bi LTH_MANH.IN): 11 15 1 2 8 h 54 m 28/7/2017

ặ ủ ồ ị ướ Ạ ệ ề t kê các mi n liên thông M NH c a đ th có h ậ ng (thu t toán ượ ướ ư ễ ể ở c bi u di n b i ds cung sau đây (và ds này l u trên text file t r ng đ th có h ng này đ

{Main Prog.} Begin clrscr; Write('Nhap ten tep du lieu:'); readln(tf); Assign(f,tf); Reset(f); Readln(f,n); For i:=1 to n do For j:=1 to n do Read(f,c[i,j]); Close(f); Write('Cho biet dinh xuat phat:'); Readln(u); Writeln('Duong di Euler tim duoc:'); Writeln; dem:=0; For j:=1 to n do check[j]:=true; L1:dem1:=0; For j:=1 to n do

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

166

If c[u,j]=1 then Inc(dem1); dem:=dem+1; If dem1=1 then Begin For j:=1 to n do If c[u,j]=1 then Begin check[u]:=false; c[u,j]:=0; c[j,u]:=0; Writeln('Di qua canh thu ',dem,' dung 1 lan la tu:',u,'>',j); u:=j; Goto L1; End; End Else Begin For j:=1 to n do If c[u,j]=1 then Begin If L_thg(u,j,check)=1 then Begin c[u,j]:=0; c[j,u]:=0; Writeln('Di qua canh thu ',dem,' dung 1 lan la tu:',u,'>',j); u:=j; Goto L1; End End End; Readln; End.

ở ạ ầ ể ả ồ ị ướ ệ ướ ễ ướ ị ạ ượ ả ớ ồ ị t kê c nh. Yêu c u: Program ng: gõ ng: gõ 0; đ th có h ồ ị ng (đ th vô h c c v i đ th vô h ồ ị ể ồ ị ng và đ th có h

ỉ ộ ắ ả ạ

7 Tìm và hi n th chu trình EULER trên đ th bi u di n b i danh sách li ướ ph i ch y đ 1). Test1: Dùng file vào DTEUL.IN 4 5 > 4 đ nh; 5 c nh (B t bu c ph i có hai data này!) 1 2 1 4 2 3 2 4 3 4 Test 2: Dùng file vào EU1.IN 5 6 1 2 1 5 2 5 3 4 3 5 4 5 8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Ị

Ồ

167

B) Đ TH HAMILTON 8 Tìm và hi n th đ Test1: Dùng file vào DTEUL.IN 4 5 1 2 1 4 2 3 2 4 3 4 Test 2: Dùng file vào EU1.IN 5 6 1 2 1 5 2 5 3 4 3 5 4 5

ồ ị ướ ượ ể ễ ệ ể ị ườ ng đi Hamilton trên đ th vô h ng đ ở c bi u di n b i danh sách li ạ t kê c nh.

ề ủ ồ ị ử ệ ồ ị ượ t kê chu trình Hamilton trên đ th đ c ể ễ ậ ớ ạ 9/ (Bài này b n th test v i ma tr n k c a đ th ) Tìm và li ề ướ ở bi u di n b i ma tr n k d ậ i đây.

8 0 1 1 1 0 0 0 0 1 0 0 0 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 0 0 1 0 1 0

CODE: Program Chutrinh_Hamilton; Uses crt; Var i,j,n:Integer; c:Array[1..20,1..20] of byte; p:Array[1..20] of byte; b:array[1..20] of boolean; d:Word; f1,f2:Text;

Procedure Xuly; Label l1; Var t:integer; ktra:boolean; Begin ktra:=true; For t:=1 to n1 Do If c[p[t],p[t+1]]=0 then Begin 8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

168

ktra:=False; goto L1; End; If c[p[n],p[1]]=0 then ktra:=False; L1:If ktra then Begin d:=d+1; Write(f2,'Chu trinh Hamilton thu ',d,' la:'); For t:=1 to n Do Write(f2,p[t]:3); Writeln(f2); End; End;

Procedure test(k:integer); Var i1,j:integer; Begin For j:=1 to n do If b[j] then Begin p[k]:=j; b[j]:=False; If k=n then xuly Else test(k+1); b[j]:=True; End; End; {Main Prog.} Begin clrscr; Assign(f1,'CtHamil.Inp'); Reset(f1); Assign(f2,'CtHamil.Out'); Rewrite(f2); Readln(f1,n); For i:=1 to n do For j:=1 to n do Read(f1,c[i,j]); Close(f1); For i:=1 to n do b[i]:=True; d:=0; Test(1); Close(f2); Writeln('DONE!'); Writeln('Go Enter de quay ve chuong trinh!'); Writeln('De xem ket qua, go phim F3, go CtHamil.Out, roi ENTER.'); Readln; End.

Ọ Ồ Ể Ị ổ ế ả ề ả ưở ế ộ Ố ng đ n n i dung và cách gi i bài toán, ta ƯỜ Ị 10/ CHU TRÌNH HAMILTON TRÊN Đ TH CÓ TR NG S : Bài toán KINH ĐI N n i ti ng: TRAVELLING SALESMAN PROBLEM. Không h nh h ọ g i bài toán này là bài toán NG I DU L CH.

ị ố ừ ượ ườ ữ ể ế ị ể c có N đ a đi m du l ch đ 1 đ n N. Gi a hai đ a đi m b t k có th có đ c đánh s t ng đi ữ ể ằ ạ ị ể ữ ể ấ ố ố ấ ả ỗ ị ị ề ể ể ầ ộ ị ấ ỳ ị ộ ướ M t n ị ẳ ặ ườ ng đi thì giá đi (b ng ô tô ch ng h n) du l ch gi a chúng là ho c không. Gi a hai đ a di m i, j có đ ừ ị ữ nh ng s nguyên C(i,j)>0. Nói chung C(i, j) khác C(j, i). Khách du l ch xu t phát t đ a đi m k ,mu n ậ ồ t c các đ a đi m, m i đ a đi m đúng 1 l n, r i quay v k (k

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

169

ụ ụ ể ể ị ữ ệ ề ễ ậ ấ ộ ở ả ạ ư ị ỏ ớ ổ trình du l ch v i t ng chi phí C nh nh t. D li u vào cho m t ví d c th bi u di n b i ma tr n k mô t m ng du l ch nói trên nh sau:

6 0 3 0 4 0 0 3 0 4 0 2 0 0 4 0 0 1 1 4 0 0 0 1 5 0 2 1 1 0 5 0 0 1 5 5 0 1 6

CODE:

Program Nguoi_Dulich; { chu trinh Hamilton tren do thi co trong so} Uses crt; Const sd=10; fi='HMT.VAO'; fo='HMT.RA'; Type m1=Array[1..sd,1..sd] of Integer; m2=Array[1..sd] of Integer; m3=Array[1..sd] of Boolean; Var c:m1; a,x:m2; d:m3; n,cmin,sum,maxsum,dem:Integer;

Procedure Nhap; Var f:text; x,i,j:Integer; Begin Assign(f,fi); Reset(f); Readln(f,n); cmin:=maxint; For i:=1 to n do Begin For j:=1 to n do Begin Read(f,c[i,j]); If c[i,j]>0 then If (c[i,j]j) Then cmin:=c[i,j]; End; Readln(f); End; Close(f); End;

Procedure Tim_Chiphi_Min; Begin If sum+c[a[n],a[1]]

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

170

maxsum:=sum+c[a[n],a[1]]; x:=a; Inc(dem); End; End; Procedure Try(i:integer); var j:Integer; Begin If i>n Then Begin If c[a[n],a[1]]>0 Then Tim_Chiphi_Min; End Else For j:=1 to n Do If d[j] Then If c[a[i1],j]>0 then Begin a[i]:=j; d[j]:=False; sum:=sum+c[a[i1],j]; If sum+(ni+1)*cmin0 then Begin Writeln(g,'Tong chi phi cua hanh trinh DU LICH=',maxsum); Write(g,'Tour du lich KHEP KIN co chi phi min ma khach da di la:'); For i:=1 to n do Write(g,x[i],' '); Writeln(g,x[1]); End Else Writeln(g,0); End; Procedure Init; {Khoi tri cho cac bien} Var i,j:integer; Begin For i:=1 to n do d[i]:=True; maxsum:=maxint; sum:=0; a[1]:=1; d[1]:=false;

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

171

dem:=0; End; Begin clrscr; Nhap; Init; Assign(g,fo); Rewrite(g); Try(2); Xuat; Writeln; Writeln(#32:7,'XONG! GO ENTER>GO PHIM F3>GO HMT.RA>ENTER: DE XEM KET QUA.'); Readln; Close(g); End.

= = = = = = = = = = = = = = = =

Ậ VIII3/ CÁC THU T TOÁN TÌM Đ

NG ĐI

Ồ

Ấ

Ắ

ƯỜ Ị NG N NH T TRÊN Đ TH .

ườ

ấ ừ ộ

ể

ế

ắ ng ng n nh t t

m t đi m đ n các

Tìm đ

ể

ạ

Ậ VIII3.1) THU T TOÁN DIJKSTRA: ồ ị i trên đ th . đi m còn l

ướ

Ố ượ

ể

ệ

ạ t kê c nh

ấ

ậ

ễ Ọ ng CÓ TR NG S đ i đây (L u trên text file DATA.VAO có c u trúc d ướ ấ ỳ ế

ở c bi u di n b i danh sách li ướ i đây). L p trình tìm và ỉ

ấ ừ ỉ

ọ

ư ắ ị ườ ng ng n nh t t

ồ c b t k đ n đ nh đích tùy ch n trên đ

đ nh cho tr

ộ ồ ị 1 M t đ th vô h ướ d ể hi n th đ ị ấ th y.

ả

ộ

ỉ

ở

ắ 5 đ nh, 9 cung: b t bu c ph i ghi

đây

5 9 (cid:0) 1 2 1 1 5 9 2 3 2 2 4 5 3 4 1 3 5 2 4 3 7 5 2 8 5 4 10

CODE:

{Chuong trinh nay Test tren tep DATA.VAO}

Program Min_Path;

8 h 54 m 28/7/2017

ộ

ư t m t code cho bài toán trên, nh ng x lý trên file d li u vào

ỏ Bài t p nh cho b n: Vi Ề ủ ồ ị Ậ là MA TR N K c a đ th .

ườ

ữ

ắ

ọ

Ậ

Tìm đ

ấ ng ng n nh t gi a m i

Ặ ỉ

ồ ị

VIII3.2) THU T TOÁN FORDBELLMAN: C P đ nh tùy ý trên đ th KHÔNG CÓ CHU TRÌNH ÂM.

ố ồ ạ ậ

ự ẽ ị

Ặ ổ ứ ư ệ Ề Ậ

ộ ồ ị ậ

ớ ể

ồ ị

ạ

ả

2CÀI Đ T FORDBELLMAN ALGORITHM ạ ọ v b a ra m t đ th có tr ng s , r i b n l p MA (T ch c d li u VÀO: B n hãy t ủ ạ ẽ TR N K CHO nó. Code c a b n s Test trên ma tr n đó. Khi t o đ th nh ki m tra ả b o đ m nó không có chu trình ÂM)

CODE:

174

8 h 54 m 28/7/2017

ườ ọ

ồ ị

ỉ

VIII.3.3) THU T TOÁN FLOYDWARSHALL ố ỉ ặ c p đ nh thông qua các đ nh TRUNG GIAN trên đ th có tr ng s .

Ồ Ọ

ầ

3Đ H A HÓA code cho thu t toán trên. Yêu c u:

ậ ổ ấ

ể

Th y Tr n Thông Qu

Begin clrscr; initgr; Thutuc_goi_thutuc; closegraph; End.

Ự

Ụ

Ạ

Ệ

Ố B N BÀI T LUY N (TL) CHO CÁC B N ÁP D NG ALGORITHMS TRÊN ĐÂY:

ố

ướ

ừ

ỗ

ộ ố

TL1/ Trong m t m ng l ờ

thành ph i đ n thành ph j là t

ố ể

ố ộ

ấ

i thành ph s

ố

i giao thông có n thành ph và m hành trình tàu đi trong n ế ij. M i hành trình i ố i2, ố i1 vào th i đi m t i, đi qua m t dãy các thành ph s i đ hành khách lên ho c xu ng tàu.

ờ ẽ ừ ạ

ườ

ớ

ố

thành ph s t

i th i đi m t mu n đi t

ố ặ i thành ph d.

ạ ể ể ớ

ấ

ố i đó đ n d s m nh t.

ể

ấ

ạ thành ph đó. Th i gian đi t ạ xu t phát t ỗ ạ si3,..., sik. T i m i thành ph tàu s d ng l ờ ở ấ ộ i xu t phát M t ng ộ ế a) Hãy tìm l ộ b) Hãy tìm l

ố ườ trình sao cho ng ớ ố ầ trình v i s l n chuy n tàu ít nh t. ớ

ữ ệ

ạ ượ

ồ

D li u vào l u trên text file v i tên TauHoa.Vao g m các đ i l ữ ệ

ớ

ng n, m, s, t, d, ờ ồ ậ ij. D li u ra l u trên text file v i tên TauHoa.Ra g m th i

ố ầ

ể

ế

ấ

ố s hành trình và ma tr n t ớ gian đ n d s m nh t và s l n chuy n tàu ít nh t.

ớ

ộ

ầ

ố ề

ằ

ầ

ừ

ữ

ỗ ữ

ậ ố ủ

ầ ạ ở i

TL2/ M t toà nhà cao t ng có n thang máy. M i thang máy n i li n đúng 2 t ng v i nhau nh ng t ng n m gi a 2 t ng này. V n t c c a các thang máy

ờ

ể

ắ ầ

ầ ộ ầ ỗ

ề ở ầ

ấ

ắ ầ ố

ậ ứ ạ

ể

t ng th p và chúng cùng b t đ u di ầ i chuy n xu ng t ng

i t ng trên, ngay l p t c l

ư ế i nh th ... ố

ầ ở ầ

ầ

ớ ầ ầ ứ ặ ạ i lên t ng trên, và c l p l ấ ấ ầ ỉ

ữ

ổ

ệ

ể

ể ấ ể

ờ ờ

ể

ậ

ờ

và không d ng l là nh nhau: 5 giây qua m t t ng. Th i đi m b t đ u, m i thang máy đ u ể chuy n lên t ng trên. Sau khi t ướ ồ ạ d i, r i l ủ t ng 1 (t ng th p nh t) và mu n nhanh chóng lên t ng trên cùng c a An đang ế ủ ầ toà nhà. Anh ta thay đ i thang máy ch trên nh ng t ng chung c a 2 thang máy và n u ớ ầ i t ng này thì vi c chuy n thang máy khi đó thang máy kia t ớ ư coi nh không t n th i gian. Hãy l p trình tính th i gian ít nh t đ An có th lên t i ầ t ng trên cùng c a toà nhà.

ạ i th i đi m này cũng t ố ủ ấ

ữ ệ

ớ

ồ

ầ

ươ

ứ

ố

ng K, N cách nhau ít nh t m t d u cách,

182

D li u vào c t trên text file v i tên Lift.In g m: (cid:0) Dòng đ u tiên ch a 2 s nguyên d ố

ố ầ

ủ

ấ N (cid:0)

K (cid:0)

ộ ấ 50000).

ế

(cid:0)

1000; 1 (cid:0) (cid:0) Trên m i m t N dòng ti p theo ghi 2 s nguyên d ươ ầ

ả ộ

ữ

là s t ng và s thang máy c a toà nhà (2 ố ể m t thang máy di chuy n gi a 2 t ng A, B (1

ộ ỗ d u cách) mô t

ộ ng A, B (cách nhau m t K).

A < B (cid:0)

ấ Chú ý:

(cid:0)

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ạ

nào khác nhau mà l

ầ ệ

ữ ệ ả

ỉ ộ

ớ

ủ

ụ

ể

ầ

ữ ể i cùng di chuy n gi a 2 t ng nh nhau. ồ ạ ả ả i nghi m. — D li u vào đ m b o luôn luôn t n t ồ K t qu ghi lên text file v i tên Lift.Ou g m: ch m t dòng ghi th i gian ít ộ

ờ Ví d : Xem 2 b

ướ

ế ấ nh t mà An có th di chuy n lên t ng trên cùng c a toà nhà. ữ ệ d li u d

i đây:

Lift1.Ou

Lift1.In 10 4 1 5

5 10 5 7 7 10

Lift2.In Lift2.Ou 20 5 150

1 7 7 20 4 7 4 10 10 20

183 — Không có 2 thang máy

ự

ỉ ồ

ộ

ố

255) và n xâu ký t

có cùng đ dài L ch g m các

(cid:0)

TL3/ Cho s nguyên k (0 < k ườ

ữ

ng (0 < n

ồ ạ

ấ

ỏ

ả

100) và (0 < L (cid:0) ấ

ộ 255) là S1, S2,..., Sn. đôi m t khác nhau. ị i k v trí khác nhau trong

ọ

ộ

ấ

ế

ệ

ị 1, S2,..., Sn. Ta g i p là v min, p, L) = S.

ấ ữ ệ

ch cái th Hãy tìm xâu Smin nh nh t tho mãn tính ch t sau: t n t ệ ị xâu Smin là các v trí xu t hi n c a m t trong các xâu S ủ trí xu t hi n c a xâu S trong S D li u vào c t trên text file ấ

ồ :

ầ ế

ứ ớ

ế

ả

ệ

ầ

ủ ị ủ min n u giá tr c a hàm Copy(S ớ v i tên Str.In g m (cid:0) Dòng đ u ghi n, L, k : (cid:0) n dòng ti p theo, dòng th i ghi xâu S K t qu ghi lên text file v i tên Str.Ou g mồ : (cid:0) Dòng đ u tiên ghi đ dài nh nh t: ỏ ấ ộ ầ (cid:0) Dòng th 2 ghi xâu S ả ề ứ min tho đi u ki n đ u bài (xem 2 file bên).

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ỗ

ộ

ố

ế ự

ủ

ấ

ạ

ế i p trong xâu S

ệ t s xu t hi n c a xâu S

min. M t ví d c

u t

ướ

ể

ghi 2 s u, p cho bi th cho d

i đây:

Str.In Str.Ou

2 10 2 17 aaaaaaaxyz aaaaaaaxyzabcdefg xyzabcdefg 1 1 2 8

ậ

ữ

ẻ

ả

ậ ượ ố ự ng là m t s nguyên (hay s th c thì cũng ch ng nh h ộ

ặ ạ

ừ

ế

c k ô vuông. Các túi rác ế ưở ẳ ng gì đ n cách ớ ô góc trên cùng trái đ n góc du i

i m i ô vuông. M t robot đi t

ỗ ể

ặ

ố

ỉ ậ ể

ượ

ế

ộ

t code tìm m t chi n thu t đ robot gom đ

ả c kh i

ợ

ộ ế TL4/ M t bãi t p k t rác hình ch nh t đ ộ ố ố ượ có kh i l i bài toán!) đ t t gi ả ủ ậ cùng ph i c a bãi rác đ gom rác theo lu t sau: robot ch đi xu ng ho c sang ph i ố ủ ạ theo các c nh c a ô vuông. Vi ấ ớ lu ng rác l n nh t.

184 (cid:0) k dòng ti p theo, m i dòng ụ ụ

Ồ

Ấ

Ắ

ế

ộ

VIII4. CÂY KHUNG (SPANNING TREE) & BÀI TOÁN TÌM CÂY Ị KHUNG NG N NH T (SPANNING TREE MIN) TRÊN Đ TH . Ôn m t chút lý thuy t:

ồ ị

ướ

Ỉ

ng, liên thông G = {V, E} có N Đ NH

A) CÂY KHUNG LÀ GÌ? Cho đ th vô h

N (cid:0) 1 c nhạ ( W (cid:0)

V, F (cid:0)

ọ E) g i là

CÂY

ọ ồ ị ủ ồ ị

(N > 1). M i đ th con H = {W, F} có KHUNG c a đ th G.

ồ ị

Ọ

ồ ị

ủ

ấ ả

ọ

ố

Ấ ủ ạ c a nó là

B) CÂY KHUNG MIN LÀ GÌ? Cho đ th vô h Ố ướ ng có TR NG S không âm, liên Ắ ỉ thông G = {V, E} có N đ nh (N > 1), cây khung NG N NH T (CKMIN) c a đ th G ổ là cây khung có t ng tr ng s trên t

t c các c nh

ấ . ỏ nh nh t

ị

ướ

ọ

ng, liên thông và có tr ng s

ố

ồ ấ ủ

ắ

C) BÀI TOÁN TÌM CKMIN: Cho đ th G vô h không âm. Hãy tìm cây khung ng n nh t c a G.

ế

ậ

ả

ậ

Đ n nay có 2 thu t toán gi

i bài này: thu t toán KRUSCAL & thu t toán PRIM.

ồ ị

Ặ ứ

ủ

ấ

ổ

ướ

ượ

ễ

ể

Ậ 5 CÀI Đ T THU T TOÁN KRUSCAL a) T ch c Data: C u trúc c a đ th cho tr

c đ

ở c bi u di n b i danh sách li

ệ t

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ố

i đây (các s cách ự ố

ướ ạ kê c nh d ộ nhau m t ký t

tr ng):

Th y Tr n Thông Qu

End.

ướ

ủ

ấ

ị

ượ

ể

ễ

ệ

Ậ Ặ 6) CÀI Đ T THU T TOÁN PRIM ổ ứ ữ ệ aT ch c d li u: ồ C u trúc c a đ th cho tr

c đ

ở c bi u di n b i danh sách li

ạ t kê c nh d

ướ i

đây:

ự ố

ộ

ỗ

tr ng):

ố ỉ

ố ạ

9: s đ nh; 14: s c nh

ố ư và l u tren text file PRIM.IN (các s trên m i dòng cách nhau m t ký t 9 14 (cid:0) 1 2 4 1 8 8 2 3 6 2 8 11 3 4 7 3 6 4 3 9 2 4 5 9 4 6 14 5 6 10 6 7 2 7 8 1 7 9 6 8 9 7

b CODE:

Program Prim_Algol; Uses crt; Const Ln=50; fi='PRIM.IN'; {fi=Tep luu data vao} fo='Ra.kq'; { Tep ghi ket qua cua chuong trinh} Type m1=Array[1..Ln,1..Ln] of integer; m2=Array[1..Ln] of integer; Var a:m1; {mang ghi nho trong so cua do thi} d:m2; {mang ghi nho dinh da nap vao cay khung nho nhat} d1,d2:m2; {mang ghi nho cac canh cua cay khung nho nhat} n,tong:Integer;

Procedure Doc; Var f:text; i,j,x:Integer; Begin

188

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Assign(f,fi); Reset(f);

Readln(f,n);

While Not SeekEof(f) Do Begin Readln(f,i,j,x); a[i,j]:=x; a[j,i]:=x; End; Close(f); End;

Procedure Timcanhmin(Var i,j:Integer); Var x,y,wmin:Integer; {wmin: trong so nho nhat} Begin wmin:=Maxint; For x:=1 to n Do If d[x]=1 Then For y:=1 to n Do If d[y]=0 then If (a[x,y]>0) and (a[x,y]

Procedure TtPrim; Var i,j,k:Integer; Begin For i:=1 to n Do d[i]:=0; d[1]:=1; For k:=1 to n1 do Begin Timcanhmin(i,j); d[j]:=1; {danh dau dinh j da duoc nap vao cay khung} d1[k]:=i; {luu dinh dau cua canh da nap vao cay khung} d2[k]:=j; {luu dinh cuoi cua canh da nap vao cay khung} End; End;

189

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

Procedure ghi; Var f:Text; i:integer; Begin Assign(f,fo); Rewrite(f); tong:=0; For i:=1 to n1 do Begin Writeln(f,d1[i],' ',d2[i]); tong:=tong+a[d1[i],d2[i]]; End;

Writeln(f,'Tg trg_so=',tong); Close(f); End;

Procedure Xem_kq; Var f:Text; line:string[12]; Begin Writeln(#32:20,'KET QUA CHAY CHUONG TRINH:'); Writeln('Tap cac canh cua Ck_min va tong trong so cua no (dong cuoi):'); Writeln; Assign(f,'Ra.kq'); Reset(f); While Not SeekEof(f) Do Begin Readln(f,line); Writeln(#32:7,line); End; close(f); End; Begin clrscr; Doc; TtPrim; Ghi; Xem_kq; Readln; End.

Ự

ự

Ệ

ấ

Ạ BÀI T LUY N CHO CÁC B N (Th c ch t là tìm CKMIN)

190

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ố ầ

ả

ự TL1/ M t thành ph c n tr i nh a

ộ ạ

ọ

v (d thôi).

ồ ị

ự

ả

ầ ữ

ượ

ở ồ ị ạ ự ẽ ễ ố ủ Tr ng s c a ữ ả ườ ng. C n ph i tr i nh a nh ng ấ ự c tr i nh a gi a hai nút giao thông b t

ộ ng đi đ Ự

ể ẫ ƯỢ

ả Ắ

Ấ

m ng giao thông có N nút giao thông cho b i đ th b n t ạ ể ễ các c nh đ th này bi u di n đ dài các con đ ườ ườ con đ ng nào đ v n có đ Ả Ộ ỳ k mà Đ DÀI Đ

C TR I NH A LÀ NG N NH T.

ữ

ề

ắ

TL2/ Gi

ế ặ

ủ ồ ị ạ t code đ sao cho chi phí thi

ể ữ ệ

ượ

ữ

ề

ẫ

Ỳ

ệ

ạ

ở ộ ố ỉ ả ử ạ ề ữ ệ s m ng truy n d li u gi a các trung tâm máy tính m t s t nh mi n B c cho ể ố ở ồ ị ạ ự ẽ ị ọ v . Tr ng s ghi trên các c nh c a đ th này bi u th CHI PHÍ xây b i đ th b n t ề ữ ệ ạ ế ề ữ ệ ườ ự t đ t m ng truy n d li u ng truy n d li u. Vi d ng đ ộ Ấ ả ả Ấ là ÍT NH T mà v n đ m b o truy n d li u đ c gi a 2 trung tâm B T K thu c ơ ị ề m ng. (Đ n v ti n chi phí: Tri u).

ộ

ệ ố

ằ

ớ

TL3/ Có n phòng làm vi c c a m t công ty đ

ệ

ơ ồ ố

ệ

ậ

ở

ệ ủ ủ ố

ạ ữ

ệ

ớ

ộ ế

ữ

ố

N u không có dây đi n n i gi a phòng i v i phòng j thì A[i, j] = 0. Hi n t

ố ế ượ c n i ti p v i nhau b ng h th ng dây ễ ể đi n. S đ n i dây c a m ng đi n này bi u di n b i ma tr n A[i, j], trong đó A[i, j] là đ dài dây đi n n i gi a phòng i v i phòng j. ớ ệ ư

ố ớ

ề

ừ ầ ử ạ

ệ

ộ

ố

ệ ạ i n i nh ng quá th a nên lãng phí. Hãy tìm i cách n i đi n sao cho

ệ ng dây đi n n i t ệ ố ệ

ườ ấ ủ ề

phòng này đ u có đ ắ ổ t ng đ dài ng n nh t c a h th ng dây đi n c n s a l n phòng c a công ty đ u có đi n.

ầ

ớ

ủ ữ ệ

ậ

ộ

ố

ỗ

ố ấ

D li u vào c t trên text file v i tên E_line.In. Dòng đ u tiên là s phòng n; n ự

ma tr n A[i, j], m i dòng n s cách nhau ít nh t m t ký t

ấ ả ế ế dòng k ti p mô t tr ng.ố

ế

ả ấ

ầ

ộ

ớ

ệ

ị

K t qu c t trên text file v i tên E_line.Ou mà dòng đ u là t ng đ dài dây ườ ỗ ng

ổ ể ố i và vj bi u th có đ

ố

ớ

i (i = 1, 2, 3, ...)

ấ ữ ệ

ụ ể ủ

ợ

ớ

i v i phòng v ng h p c th c a bài toán này v i file vào và xu t d li u cho

M t tr ướ

đi n dùng cho công ty; các dòng sau m i dòng ghi 2 s u dây n i phòng u ườ ộ i đây:

E_line.In E_line.Ou

4 5

3 4 1 4 2 4

0 3 4 2 3 0 3 2 4 3 0 1 2 2 1 0

= = = = = = = = = = = = = = = = = =

191

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

192

Ồ

Ầ

Ị

PH N IX. Đ TH HAI

Ả Ố Ư Ự Ạ Ậ Ị

PHÍA Ặ

Ụ (ÁP D NG GI I VÀI BÀI TOÁN TÌM C P GHÉP C C Đ I VÀ L P L CH T I U)

Ệ Ơ Ả Ộ Ể AÔN M T VÀI KHÁI NI M C B N Đ LÀM TOÁN

ồ ị ế 1/ Th nào là đ th hai phía?

ỉ ỉ ỏ ậ ỗ

ạ ồ ợ ậ ạ ộ ề ệ ỏ ở ồ ị ồ ị ọ trên g i là đ th HAI PHÍA (đ th hai phía cũng ệ ậ Cho t p đ nh V1 và t p đ nh V2 th a mãn: V1 Giao V2 = R ng (a) V1 H p V2 = V (b) và t p c nh E g m các c nh e = (v1, v2) mà ộ v1 Thu c V1, v2 Thu c V2 (c) ậ T p G = {V,E} v i V, E th a các đi u ki n a, b, c ượ đ ớ c ký hi u là G{V1, V2, E}).

ề ặ ồ ị ạ 2/ Hai d ng bài toán v c p ghép trên đ th hai phía:

ệ ặ ị c h t c n đ nh nghĩa khái ni m c p ghép: ố ạ ủ ự ặ ạ

ủ ặ 2.1) Tr ỉ Ta g i t p PAI g m các c nh thu c E và không có đ nh nào chung là c p ghép. S c nh c a PAI là l c ượ l ướ ế ầ ồ ọ ậ ng c a c p ghép và ký hi u ộ ệ (cid:0) PAI(cid:0) .

ặ

ề ỉ Ủ Ầ ặ ạ ọ (cid:0) PAI(cid:0) = N thì PAI g i là c p ghép Đ Y Đ . Hai d ng bài toán v ề ế ầ ủ ệ ị 2.2) Ti p theo là đ nh nghĩa khái ni m c p ghép đ y đ : ế ậ N u t p V1 và V2 đ u có N đ nh và ặ c p ghép:

ậ ự ượ ầ ủ ự ạ ặ ườ ợ ng |PAI| c c đ i. Bài toán tìm c p ghép đ y đ là tr ng h p riêng ạ 2.3) D ng 1 Đây là bài toán tìm t p PAI có l c l ủ c a bài toán này.

Ặ ạ ặ Ọ Ắ Ổ Ấ ắ C C Đ I, viêt t ặ t: C p Ự Ạ Ọ ộ ậ ộ ạ Ặ Ị Ế ạ ể ả ơ ả ạ 2.4) D ng 2 (C P GHÉP C C Đ I) Ự Ạ Ố Ớ Tìm c p ghép có T NG TR NG S L N NH T (G I T T LÀ C P GHÉP ộ ố ghép Max) trên các c nh thu c t p PAI. M t s các bài toán X P L CH thu c d ng này. ậ Đ gi i hai d ng bài toán trên ta có các thu t toán c b n sau:

ồ ậ ề ồ ị ơ ả ự ử ể ặ ệ

ắ

ậ ậ ậ ậ ế ầ ị aThu t toán c b n d a vào đ th hai phía, dây chuy n (lu ng) và s a nhãn đ tìm c p ghép Max, bĐ quy – Quay lui, ộ ạ cQuy ho ch đ ng, ế dS p x p Topo, eThu t toán Jonson, fThu t toán Heristic, gThu t toán Hunggari, ả gThu t toán làm M n d n k t qu .

Ỉ Ụ Ệ ƯỚ Ố ể ạ ả Ề Ậ Ồ ụ Ế ể ả ầ ế ở t ế Ộ I ĐÂY CH CÓ ĐI U KI N NÊU VÀI BÀI TOÁN ÁP D NG M T D S TRONG CÁC THU T TOÁN TRÊN. (Các b n có th tham kh o chi ti Ị quy n LÝ THUY T Đ TH , NXB Giáo D c, 2012, Tác gi : Tr n Thông Qu ).

Ặ Ả Ậ I CÁC BÀI TOÁN C P GHÉP SAU:

(cid:0) ộ ớ ọ ồ ườ ố ứ ự ừ ế ắ ạ ơ BL P TRÌNH GI 1/ Bài toán 1. M t l p h c sinh g m N ng i (đánh s th t t 1 đ n N và N 1000) đi c m tr i tham gia trò ch i

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

193

ớ ặ ư ớ ố ng i m i em n ghép c p v i m t em nam). Ng ớ ộ ữ ộ ổ ỗ ủ ữ ặ ườ ặ ượ ạ c l ộ ớ ấ

ồ ố ỗ ế ố ệ ủ ố ệ ủ ữ ộ ủ ặ ớ ả ế ồ ấ ủ ươ ứ ầ ặ ớ ổ ng là t ng đ ăn ý l n nh t c a các c p ghép. ố ế ụ ụ ể ộ

ộ ỗ nh sau: m i em nam ghép c p v i m t ươ ộ ặ ữ em n (và ng i ta dùng m t tham s nguyên d ể ấ ầ w đ đánh giá đ ăn ý c a các c p ghép đó. Yêu c u tìm nh ng c p ghép cho t ng đ ăn ý l n nh t. ồ ữ ệ D li u vào c t trên text file v i tên Ghepcap.In g m: * Dòng 1 là s N.ố ớ * Các dòng ti p theo m i dòng g m 3 s x, y, w v i ý nghĩa : x là s hi u c a nam sinh, y s hi u c a n ạ sinh, w là đ ăn ý c a 2 b n đã ghép c p v i nhau. ớ K t qu ghi lên text file v i tên Ghepcap.Ou g m: ộ ộ ố * Dòng đ u ch a m t s nguyên d ỗ * Các dòng ti p theo m i dòng ghi 3 s x, y, w. M t ví d c th là: Ghepcap.In 4 1 2 2 1 3 1 4 2 3 4 3 1

Ghepcap.Ou 4 1 3 1 4 2 3

1) CODE1. (Phuong an 1: Dung de quy quay lui de tim cap ghep CUC DAI) Program GhepNamNu; Uses crt; Const fi='Ghepcap.In'; fo='Ghepcap.Ou'; min=10000; Var f:text; n:integer; Test,Free: array[1..100] of boolean; A: array[1..100,1..100] of integer; Trace,besttr: array[1..100] of integer; nho:integer;

Procedure Nhap; Var i,j1,j2,j3:integer; Begin assign(f,fi); reset(f); readln(f,n); for i:=1 to n do for j1:=1 to n do a[i,j1]:=min; for i:=1 to n do begin test[i]:=true; free[i]:=true; end; for i:=1 to n do Begin readln(f,j1,j2,j3); A[j1,j2]:=j3; A[j2,j1]:=j3; test[j2]:=false; End; close(f);

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

ế

Th y Tr n Thông Qu

198

ả ả ố ứ ự ớ ả ướ ư ả ị c bó hoa có s th t l n, nên m ng L xác đ nh nh sau: ặ

ầ yêu c u khi ghép ph i đ m b o: bó hoa ả ứ ố ứ ự bé ph i đ ng tr có s th t ế * N u i > j thì không có cách ghép c p. ế * N u i = j thì L[i, j] = v[1, 1] + v[2, 2] + ... + v[i, i]. ế * N u i < j thì L[i, j] = Max(L[i—1,j —1] + v[i, j], L[i, j — 1]).

Ộ

Ạ bCODE (QUY HO CH Đ NG) Program CAMHOA; Uses Crt; Const max=100; Var v:Array[1..max,1..max] of integer; L:Array[0..max,0..max] of longint; cap:Array[1..max] of integer; n, k:integer; f:text; Procedure Doc; Var i,j:integer; Begin Assign(f,'Bt2.In'); Reset(f); Readln(f,n,k); For i:=1 to k do For j:=1 to n do Read(f,v[i,j]); close(f); End;

Function Lonnhat(x,y:integer):integer; Begin If (x>y) Then Lonnhat:=x else Lonnhat:=y; End;

Function Thamymax(i:integer):integer; Var j, s:integer; Begin s:=0; For j:=1 to i do s:=s+v[j,j]; thamymax:=s; End;

Procedure Xuly; Var i,j:Integer; Begin For i:=1 to max do For j:=1 to max do L[i,j]:=maxint; For i:=1 to k do For j:=1 to n do If i=j Then L[i,j]:=ThamyMax(i) Else If i

8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

199

Procedure Xuat; Var i,j,d:integer; Begin Assign(f,'Camhoa.ou'); Rewrite(f); Writeln(f,'Tong max cua do tham my:',L[k,n]); i:=k; j:=n; d:=0; While (i>0) And (j>0) do If (L[i,j]=L[i,j1]) And (v[i,j]>0) Then Begin Cap[i]:=j1; Dec(j); End Else Begin cap[i]:=j; dec(i); dec(j) End; For i:=1 to k do Writeln(f,'Bo hoa thu ',i,' cam vao lo ',cap[i]); Close(f); End;

ả ầ ượ ế ẩ ỗ t, m i chi ti t ph i l n l t gia công trên hai máy A, B (A ậ ị ể ờ ờ ữ ệ ấ ớ ồ ầ ố ế ả ớ Procedure Xem; Var f:text; line:string; Begin Assign(f,'Camhoa.ou'); Reset(f); Writeln(#32:13,'KET QUA PROGRAM:'); Writeln; While not (seekeof(f)) do Begin Readln(f,line); Writeln(#32:7,line); End; close(f); End; {Main Prog.} Begin clrscr; Doc; Xuly; Xuat; Xem; Write('Done!'); Readln; End. 3/Bài toán 3. M t s n ph m có N chi ti ế ộ ả ế ướ c, B sau). Th i gian đ gia công chi ti tr t trên máy A là Ai, trên máy B là Bi (i = 1,2,...,N). Hãy l p l ch ấ ế ớ hoàn thành các chi ti t v i th i gian ít nh t. D li u vào c t trên text file v i tên Bt3.In g m : ố *Dòng đ u tiên ghi s n. ế *N dòng ti p theo, dòng i + 1 là s ai và bi. ồ K t qu ghi lên text file v i tên Bt3.Ou g m :

8 h 54 m 28/7/2017

ế

Th y Tr n Thông Qu

205

ả ầ ượ ượ ự ệ ộ ệ ớ ố ệ t đ c th c hi n.

ế K t qu ghi lên text file v i tên Lt2.Ou ỉ ch có m t dòng ghi s hi u các vi c đã l n l Lt2.In 10 1 2 3 2 4 10 3 5 4 6 8

Lt2.Ou 1 2 7 9 4 6 3 5 8 10

ỗ ể ườ t ti n công ph i tr cho ng ờ ượ ờ ề ệ ể ả ả ườ ế ề ế ị i làm thuê, th i gian đ hoàn thành ề ấ i làm thuê thu đ c nhi u ti n công nh t. ồ ệ ữ ệ ố ầ ươ ớ ng N. ố ệ ế ệ ể ờ ờ

ề ế ả ồ ớ ầ ấ ổ ớ ố ố ệ ế ể ệ ỗ ờ ề ệ ể ế ờ

ộ ữ ệ ả ế ệ ể ố ờ ệ ớ LT3. Có N vi c. V i m i vi c cho bi ệ ế vi c, th i đi m k t thúc vi c. Hãy x p l ch sao cho ng ấ D li u vào c t trên text file v i tên Lt3.In g m : * Dòng đ u là s nguyên d ** N dòng sau, dòng i + 1 ghi 3 s : th i gian hoàn thành công vi c t, th i đi m k t thúc công vi c k và ti n công tc. K t qu ghi lên text file v i tên Lt3.Ou g m : ề * Dòng đ u là t ng ti n công l n nh t. ắ ầ * Các dòng ti p theo m i dòng ghi 4 s : s hi u công vi c i, th i đi m b t đ u ệ công vi c t1, th i đi m k t thúc công vi c t2, ti n công tc. ậ Thu t toán : ế * X p tăng b d li u theo khoá là th i đi m cu i cùng ph i k t thúc công vi c.

Lt3.In 10 1 4 89 5 5 86 4 11 83 5 7 84 1 2 25 3 11 61 6 11 33 4 7 28 3 10 1 5 14 71

Lt3.Ou 329 5 0 1 25 1 1 2 89 3 2 6 83 6 6 9 81 10 9 14 71

ế ệ ố ừ ầ ượ ố ự ệ ế ộ c b trí th c hi n trên m t máy. Bi t:

ệ ố 1 đ n N c n đ ệ ả ế ệ ạ ủ ng ph t c a vi c i. ự ự ự ắ ầ ệ ệ ệ ậ ổ

LT4 Có N vi c đánh s t ể ờ * pi là th i gian đ hoàn thành vi c i. ờ ể * di là th i đi m cu i cùng ph i k t thúc vi c i. ệ ố ưở * hi là h s th ị ệ ể ờ ti). Th i đi m b t đ u th c hi n các vi c là 0, hãy l p trình t th c hi n N vi c sao cho t ng giá tr 8 h 54 m 28/7/2017

ầ

ế

Th y Tr n Thông Qu

206

ệ ưở ạ ủ ấ ả ng ph t c a t

ắ ớ i lúc k t thúc, không cho phép ng t quãng. ắ ầ lúc b t đ u cho t ệ ể ờ ế ả ử ằ ự ể ừ ệ s ti là th i đi m hoàn thành vi c i, khi ạ ữ ệ ầ

ố ố ố ố ế ả ớ ồ ươ ng N (N < 2001) ươ ng p1,...,pN. ươ ng d1,...,dN. ươ ng h1,...,hN. ồ ấ ượ ầ c. ạ ớ ệ ệ ố ng ph t l n nh t tìm đ ự ự th c hi n các vi c.

ớ t c các vi c là l n th nh t.ấ (cid:0) M i vi c ph i th c hi n liên t c t ỗ ụ ừ ệ ả ệ ệ ư ờ Coi nh th i gian chuy n t vi c này sang vi c khác b ng 0. Gi ệ ị ưở ng, ph t vi c i là hix(di đó giá tr th ấ D li u vào c t trên text file v i tên Bt8.In g m: *Dòng đ u ghi s nguyên d * Dòng 2 ghi N s nguyên d * Dòng 3 ghi N s nguyên d * Dòng 4 ghi N s nguyên d ớ K t qu ghi lên text file v i tên Bt8.Ou g m : ị ưở * Dòng đ u ghi giá tr th * Dòng 2 ghi N s là trình t Ví d :ụ Test_1 Lt4.In 5 2 2 3 4 3 3 2 10 11 9 1 2 2 1 3