Bài tập Pascal cơ bản đến nâng cao

h:=readkey; if ch=#27 then stop:=true; End; 8 h 54 m 28/7/2017 139 Thầy Trần Thông Quế 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; Begin j:=0; repeat inc(j); if a[j] and b[i+j] and c[i-j] then begin h[i]:=j; Put_Queen((i-1)*50+10,(j-1)*50+10); Music; a[j]:=false;b[i+j]:=false;c[i-j]:=false; if i<8 then Try(i+1) else Wait; a[j]:=True;b[i+j]:=true;c[i-j]:=true; Put_Queen((i-1)*50+10,(j-1)*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); 8 h 54 m 28/7/2017 140 Thầy Trần Thông Quế outtextxy(430,310,'Go Esc Ket Thuc !'); repeat ch:=readkey until ch=#27; End; BEGIN Initgr; Table; Search; Closegraph; END. = = = = = = = = = = = = = = = = = = = = = = PHẦN VIII. GRAPH THEORY & APPLICATIONS VIII.1-TÌ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. (Nếu quên OR lơ 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- xem quyển: LÝ THUYÊT ĐỒ THỊ, nxb GIÁO DỤC 2012. Tác giả: Trần Thông Quế) A/ CÁC THUẬT TOÁN TÌM KIẾM (DUYỆT) TRÊN ĐỒ THỊ. 1-Hãy cài đặt trực quan (đồ họa hóa code) hai thuật toán DBF và BFS trên cùng một bản Code (BÀI CƠ BẢN NHƯNG KHÔNG DỄ!). Yêu cầu: * Gõ ENTER để chuyển từ thuật toán DFS sang BFS và ngược lại, * Gõ ESC để thoát CODE: PROGRAM DFS_BFS_SEARCH; USES CRT,GRAPH; CONST R=15;DL=500;N=8;VC=100; {KHONG CO DUONG DI THI DAT VO CUC VC=100} C:ARRAY[1..8] OF INTEGER=(150,330,450,450,330,150,30,30); D:ARRAY[1..8] OF INTEGER=(30,30,150,330,450,450,330,150); CL:ARRAY[0..3] OF WORD=(BLUE,YELLOW,WHITE,WHITE); NL:ARRAY[0..3] OF WORD=(YELLOW,BLUE,RED,BLACK); TYPE CSD=0..VC; AR=ARRAY[CSD] OF CSD; QUEUE=RECORD REAR:CSD; ELEMENT:AR; END; VAR G:ARRAY[CSD,CSD] OF BOOLEAN; 8 h 54 m 28/7/2017 141 Thầy Trần Thông Quế I,J,K,U:CSD; P:AR; (*-----------------------------------------------------------*) PROCEDURE INITGR; { KHOI TAO DO HOA} VAR GD,GM:INTEGER; BEGIN GD:=DETECT; INITGRAPH(GD,GM,'..\BGI'); IF (GRAPHRESULT GROK) THEN BEGIN WRITELN('LOI KHOI TAO DO HOA, GO ENTER KET THUC !'); READLN; HALT(1) END END; (*-----------------------------------------------------*) PROCEDURE ADD(X:CSD;VAR Q:QUEUE); {THEM PHAN TU TU DUOI HANG DOI} BEGIN WITH Q DO BEGIN REAR:=REAR+1; ELEMENT[REAR]:=X END; END; (*-----------------------------------------------------*) PROCEDURE DELETE(VAR Q:QUEUE;VAR X:CSD); {BOT PHAN TU KHOI HANG DOI} VAR K:CSD; BEGIN WITH Q DO BEGIN X:=ELEMENT[1]; FOR K:=1 TO REAR-1 DO ELEMENT[K]:=ELEMENT[K+1]; REAR:=REAR-1 END; END; (*-----------------------------------------------------*) PROCEDURE VENUT(U:CSD;M1,M2:WORD); {VE CAC DINH DO THI} VAR ST:STRING[3]; BEGIN SETFILLSTYLE(1,M2); SETCOLOR(M1); FILLELLIPSE(C[U],D[U],R,R); STR(U,ST); OUTTEXTXY(C[U]-2,D[U]-2,ST); END; (*-------------------------------*) 8 h 54 m 28/7/2017 142 Thầy Trần Thông Quế PROCEDURE LINK(X,Y:CSD;M:WORD); BEGIN SETCOLOR(M); LINE(C[X],D[X],C[Y],D[Y]); END; (*-------------------------------*) PROCEDURE DATA_AUTO_CREA; {TU DONG TAO DU LIEU NGAU NHIEN CHO PROG.} BEGIN RANDOMIZE; FOR I:=1 TO N DO BEGIN G[I,I]:=FALSE; FOR J:=I+1 TO N DO BEGIN G[I,J]:=RANDOM(3)=1; G[J,I]:=G[I,J] END; END; FOR I:=1 TO N DO BEGIN J:=0; REPEAT J:=J+1 UNTIL G[I,J] OR (J=N); IF (J=N) AND (NOT G[I,N]) THEN BEGIN J:=1+RANDOM(N); IF J=I THEN IF I<N THEN J:=I+1 ELSE J:=I-1; G[I,J]:=TRUE;G[J,I]:=TRUE END; END; END; (*--------------------------------------------------*) PROCEDURE DEMO(ST:STRING); {IN TEN CAC VIEC} BEGIN SETCOLOR(WHITE); OUTTEXTXY(500,30,'Duyet Do Thi'); OUTTEXTXY(500,90,ST); SETCOLOR(YELLOW); OUTTEXTXY(490,150,'Go Enter Tiep Tuc ...'); SETCOLOR(RED); OUTTEXTXY(490,210,'Go Esc Ket Thuc !'); END; (*--------------------------------------------------*) PROCEDURE PRINT_GRAPH; {IN DO THI} VAR ST:STRING[3]; 8 h 54 m 28/7/2017 143 Thầy Trần Thông Quế BEGIN SETBKCOLOR(BLUE);CLEARDEVICE; SETFILLSTYLE(1,DARKGRAY); BAR(0,0,GETMAXY,GETMAXY); FOR I:=1 TO N DO FOR J:=1 TO N DO IF G[I,J] THEN LINK(I,J,NL[0]); LINE(C[I],D[I],C[J],D[J]); FOR I:=1 TO N DO VENUT(I,CL[0],NL[0]); END; (*--------------------------------------------------*) 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.REAR0 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} 8 h 54 m 28/7/2017 144 Thầy Trần Thông Quế 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]); 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; 8 h 54 m 28/7/2017 145 Thầy Trần Thông Quế DFS; KT:=READKEY; UNTIL (KT=#27); END; (*-----------------------------------*) BEGIN (* CHUONG TRINH CHINH *) CLRSCR; INITGR; PROC_CALL_PROC; CLOSEGRAPH; END. Thử một bài duy nhất ở mức TRÊN CƠ BẢN về duyệt theo BFS: 2-(IOI-1996: THI OLYMPIC TIN HỌC QUỐC TẾ 1996) Tiếp theo thành tựu khối lập phương kỳ diệu, ô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 như nhau được tô màu khác nhau. Các màu tô được ký hiệu bởi 8 số nguyên dương đàu tiên (xem hình ngay trên) viết lần lượt theo chiều kim đồng hồ, bắt đầu từ ô góc trên cùng trái và kết thúc ở ô góc dưới cùng trái. 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 ô ở giữa Mọi cấu hình đều có thể đượ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 biến đổi cơ bản ấy mô tả bởi hình dưới đây: (Ở MỖI BỘ DATA DƯỚI ĐÂY CÁC SỐ TRÊN CÙNG VÀ DƯỚI CÙNG LÀ VỊ TRÍ CÁC Ô CỦA BẢNG) BẢNG 1 1 2 3 4  INDEX của các ô 8 7 6 5  INDEX của các ô BẢNG 2 1 2 3 4 8 7 6 5 1 2 3 4 8 7 6 5 4 1 2 3 5 8 7 6 8 h 54 m 28/7/2017 146 Thầy Trần Thông Quế BẢNG 3 Các số ghi ở ngoài bảng chỉ vị trí các ô của bảng. Nếu một ô ở vị trí p chứa số i thì có nghĩa là sau khi làm phép biến đổi tương ứng, ô vuông mà vị trí trước lúc biến đổi của nó là i sẽ được chuyển đến vị trí p. a) Hãy viế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. b) Bạn sẽ được thêm 2 điểm nếu số phép biến đổi của bạn không quá 300 * 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ả cấu hình đích. * 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 MỘT VÍ DỤ CỤ THỂ CỦA BÀI TOÁN NÀY CHO DƯỚI ĐÂY Data.In 2 6 8 4 5 7 3 1 Data.Ou 7 B C A B C C B Program MagicSquare; {BAI NAY DUYET DO THI THEO BFS) Uses crt; Const kt=8; m=40320; fi='Data.In'; fo='Data.Ou'; Type Bd=array[1..kt] of 1..kt; Ht=array[1..kt] of 1..kt; Const thuan:Array['A'..'C'] Of Bd=((8,7,6,5,4,3,2,1),(4,1,2,3,6,7,8,5), (1,7,2,4,5,3,6,8)); {Cac b_doi co ban} nguoc:Array['A'..'C'] of Bd=((8,7,6,5,4,3,2,1),(2,3,4,1,8,5,6,7), (1,3,6,4,5,7,2,8)); {Nguoc cua b_doi} dau:Ht=(1,2,3,4,5,6,7,8); {Trang thai ban dau} Var dic:Ht; {Bien luu trang thai dich} s:String; {Day cac b_doi dua tr_thai dau den tr_thai dich} fact:Array[0..kt] of Longint; {mang luu tu 0! den 8!} last:Array[0..m] of Char; {last[sh(dic)] la ky tu cuoi cung cua day cac} {b_doi dua trang thai dau ve trang thai dich} {Neu last[sh(dic)]=' ' thi dich cung rong (tuc dich khong duoc sinh} Procedure Nhap; Var tepvao:text; i:word; Begin 1 7 2 4 8 6 3 5 8 h 54 m 28/7/2017 147 Thầy Trần Thông Quế Assign(tepvao,fi); Reset(tepvao); For i:=1 to kt Do Read(tepvao,dic[i]); Close(tepvao); End; {Het nhap lieu} Procedure Facto; {Tinh giai thua} Var i:word; Begin fact[1]:=1; fact[0]:=1; For i:=2 to kt Do fact[i]:=i*fact[i-1]; End; Function sh(p:Ht):Word; {ham sh de tinh so hieu cua mot hoan vi bat ky} Var res, L, i,j:Word; Begin res:=0; For i:=1 to kt Do Begin L:=0; {L- so cac phan tu cua p o cac vi tri tu 1->i-1 nhỏ hơn p[i]} For j:=1 to i-1 Do If p[j]<p[i] Then Inc(L);{cố định i-1 p_tủ đầu tiên của p thì có (p[i]-1-L)} {so nho hon p[i] tai cac vi tri i trong cac hoan vi} {So cac hoan vi q ma i-1 p_tu ®au tien giong nhu cua p} {nhung dung truoc p theo thu tu tu dien bang (p[i]-1-L)*fact(kt-i)} res:=res+(p[i]-1-L)*fact[kt-i]; End; {Het for cua i} sh:=res; End; {Ket thuc ham sh} Procedure App(dic:Ht; x:char; Var r:Ht); {Duoc r bang cach ap dung b_doi x len trang thai dich} Var i:word; Begin For i:=1 to kt Do r[i]:=dic[thuan[x][i]]; End; Procedure bd_nguoc(dic:Ht; x:Char; Var r:Ht); {Duoc r bang cach bien doi nguoc cua b_doi x len trang thai dic} Var i:Word; Begin For i:=1 to kt Do r[i]:=dic[nguoc[x][i]]; end; {Het bd_nguoc} Function bang(r, dic:ht):Boolean; {ham bang nhan g_tri True neu r=dic} Var i:Word; Begin bang:=true; For i:=1 to kt Do If r[i]dic[i] then Begin 8 h 54 m 28/7/2017 148 Thầy Trần Thông Quế bang:=false; exit; End; End; Procedure sinh; {Tao day cac b_doi tu tr_thai dau de dat tr_thai dich} {last[sh(dic)] la phep b_doi cuoi cung cua day} Const qs=700; {kich thuoc danh sach} Var hdoi:Array[0..qs-1] of ht; {Khai bao hang doi chua cac b_doi} notfound:Boolean; head, tail, i, rankq:Word; r, s:Ht; x:Char; Begin For i:=0 to m Do last[i]:=' '; {khoi tri} last[0]:='.'; head:=0; tail:=1; hdoi[0]:=dau; notfound:=true; While notfound Do Begin r:=hdoi[head]; Inc(head); If head=qs Then head:=0; For x:='A' to 'C' Do Begin App(r, x, s); rankq:=sh(s); If last[rankq]=' ' Then Begin last[rankq]:=x; If bang(dic,s) Then Begin notfound:=false; break; End; hdoi[tail]:=s; Inc(tail); If tail=qs Then tail:=0; End; End; End; End; {ket thuc thu tuc sinh} Procedure tim; {kien tao cac phep bien doi} Var rankq:Word; x:Char; p,q:Ht; Begin q:=dic; rankq:=sh(q); s:=' '; While rankq0 do Begin 8 h 54 m 28/7/2017 149 Thầy Trần Thông Quế x:=last[rankq]; s:=x+s; bd_nguoc(q,x,p); q:=p; rankq:=sh(q); End; End; Procedure Xuat; Var tepra:text; L,i:word; Begin Assign(tepra,fo); rewrite(tepra); L:=length(s); Writeln(tepra, L-1); 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ƯỚNG 3- Cài đặt thuật toán tìm & liệt kê các thành phần (miền) liên thông của một đồ thị vô hướng. Biết rằng cấu trúc của đồ thị vô hướng đượ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 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 8 h 54 m 28/7/2017 150 Thầy Trần Thông Quế 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} 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 8 h 54 m 28/7/2017 151 Thầy Trần Thông Quế 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; 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; 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. 8 h 54 m 28/7/2017 152 Thầy Trần Thông Quế B.2) TÌM MIỀN LIÊN THÔNG MẠNH TRÊN ĐỒ THỊ CÓ HƯỚNG (THỰC CHẤT LÀ CÀI ĐẶT THUẬT TOÁN TARJAN) 4/ Cài đặt thuật toán tìm & liệt kê các miền liên thông MẠNH của đồ thị có hướng (thuật toán TARJAN). Biết rằng đồ thị có hướng này được biểu diễn bởi ds cung sau đây (và ds này lưu trên text file LTH_MANH.IN): 11 15 1 2 1 8 2 3 3 4 4 2 4 5 5 6 6 7 7 5 8 9 9 4 9 10 10 8 10 11 11 9 Kết quả lưu trên file LTH_MAMH.OU CODE: (Về duyệt đồ thị, bài này cũng dùng DFS) Program Tarjan_Alg; Uses crt; Const fi='LTH_MANH.IN'; fo='LTH_MANH.OU'; Type lk=^nut; nut=record s:word; next:lk; End; cay=array[0..200] of lk; m1=array[0..200] of word; Var sv,id,m,n,top:word; {m:so dinh; n:so canh} Num,Low,p,s:m1; dsk:cay; f:Text; Procedure Nhap; Var i,u,v: word; t:lk; Begin Assign(f,fi); Reset(f); Readln(f,m,n); {doc so dinh m, so canh n tu tep vao cac bien nho m,n} For i:=1 to n Do Begin Readln(f,u,v); New(t); 8 h 54 m 28/7/2017 153 Thầy Trần Thông Quế t^.s:=v; t^.next:=dsk[u]; dsk[u]:=t; End; Close(f); End; Function min(u,v:word):word; Begin If u<v Then min:=u Else min:=v; End; Procedure DFS(i:word); Var j:word; t:lk; Begin Inc(id); Num[i]:=id; Low[i]:=Num[i]; t:=dsk[i]; Inc(top); s[top]:=i; While Not (t=Nil) Do Begin j:=t^.s; If p[j]=0 then If Num[j]=0 then Begin DFS(j); Low[i]:=min(Low[i], Low[j]); End Else Low[i]:=min(Low[i], Num[j]); t:=t^.next; End; If Low[i]=Num[i] then Begin Inc(sv); Repeat j:=s[top]; {lay 1 phan tu ra khoi Stack tai dinh, luu vao j} dec(top); {Khi do so phan tu o Stack giam di mot} p[j]:=sv; Until i=j; End; End; Procedure Visit; var i:word; Begin For i:=1 to m do 8 h 54 m 28/7/2017 154 Thầy Trần Thông Quế If Num[i]=0 then DFS(i); End; Procedure Xuat; Var i,j:word; Begin Assign(f,fo); Rewrite(f); Writeln;Writeln; Writeln(f,'So mien lien thong la:',sv); For i:=1 to sv Do Begin For j:=1 to m Do If p[j]=i then write(f,j,' '); Writeln(f,'-> Cac dinh thuoc mien lien thong thu ',i,'.'); End; Close(f); end; Procedure Inkq; Var f:Text;line:String; Begin Assign(f,fo); Reset(f); While Not SeekEof(f) Do Begin Readln(f,line); Writeln(line); End; Close(f); End; { Main Program } Begin clrscr; Nhap; Visit; Xuat; Inkq; Readln; End. B.3) BÀI TOÁN TÔ MÀU ĐỒ THỊ 5- Hãy dùng số màu ít nhất để tô màu đồ thị có N đỉnh, sao cho hai đỉnh BẤT KỲ KỀ NHAU phải được tô bằng màu KHÁC NHAU. Yêu cầu: 1-Đồ họa hóa Code 2-Cấu trúc đồ thị tự động thay đổi nhờ nhấn phím ENTER; nhấn ESC để thoát. CODE: PROGRAM COLOR_GRAPH; 8 h 54 m 28/7/2017 155 Thầy Trần Thông Quế USES CRT,GRAPH; CONST R=15;DL=500;VC=100;N=8; C:ARRAY[1..8] OF INTEGER=(150,330,450,450,330,150,30,30); D:ARRAY[1..8] OF INTEGER=(30,30,150,330,450,450,330,150); CL:ARRAY[0..4] OF WORD=(WHITE,RED,YELLOW,BLUE,GREEN); TYPE CSD=0..VC; VAR G:ARRAY[CSD,CSD] OF BOOLEAN; V,V0,V1:SET OF CSD; I,J,K:CSD; (*------------------------------------------------------------*) PROCEDURE INITGR; VAR GD,GM:INTEGER; BEGIN GD:=DETECT; INITGRAPH(GD,GM,'..\BGI'); IF (GRAPHRESULT GROK) THEN BEGIN WRITELN('LOI KHOI TAO DO HOA, GO ENTER KET THUC !'); READLN; HALT(1) END END; (*-----------------------------------------------------*) PROCEDURE VENUT(U:CSD;M:WORD); BEGIN SETFILLSTYLE(1,M);SETCOLOR(M); FILLELLIPSE(C[U],D[U],R,R); END; (*-------------------------------*) PROCEDURE LINK(X,Y:CSD;M:WORD); BEGIN SETCOLOR(M); LINE(C[X],D[X],C[Y],D[Y]); END; (*-------------------------------*) PROCEDURE INIT_GRAPH; BEGIN RANDOMIZE; FOR I:=1 TO N DO BEGIN G[I,I]:=FALSE; FOR J:=I+1 TO N DO BEGIN G[I,J]:=RANDOM(3)=1; G[J,I]:=G[I,J] END; 8 h 54 m 28/7/2017 156 Thầy Trần Thông Quế END; FOR I:=1 TO N DO BEGIN J:=0; REPEAT J:=J+1 UNTIL G[I,J] OR (J=N); IF (J=N) AND (NOT G[I,N]) THEN BEGIN J:=RANDOM(N)+1; IF J=I THEN IF I<N THEN J:=I+1 ELSE J:=I-1; G[I,J]:=TRUE;G[J,I]:=TRUE END; END; END; (*--------------------------------------------------*) PROCEDURE MENU_PRINT; BEGIN SETCOLOR(WHITE); OUTTEXTXY(500,30,'Son Do Thi'); SETCOLOR(YELLOW); OUTTEXTXY(490,90,'Go Enter Tiep Tuc ...'); SETCOLOR(RED); OUTTEXTXY(490,150,'Go Esc Ket Thuc !'); END; (*--------------------------------------------------*) PROCEDURE PRINT_GRAPH; BEGIN SETBKCOLOR(BLUE);CLEARDEVICE; SETFILLSTYLE(1,DARKGRAY); BAR(0,0,GETMAXY,GETMAXY); FOR I:=1 TO N DO FOR J:=1 TO N DO IF G[I,J] THEN LINK(I,J,CL[0]); LINE(C[I],D[I],C[J],D[J]); FOR I:=1 TO N DO VENUT(I,CL[0]); END; (*--------------------------------------------------*) PROCEDURE COLORING; {To mau do thi} VAR CHECK:BOOLEAN; BEGIN V0:=V;K:=0; WHILE V0[] DO BEGIN K:=K+1; I:=0; REPEAT I:=I+1 UNTIL I IN V0; VENUT(I,CL[K]); DELAY(DL); 8 h 54 m 28/7/2017 157 Thầy Trần Thông Quế V1:=[I]; FOR I:=1 TO N DO IF I IN V0 THEN BEGIN J:=0; REPEAT J:=J+1; CHECK:=G[I,J] AND (J IN V1); UNTIL CHECK OR (J=N); IF NOT CHECK THEN BEGIN VENUT(I,CL[K]); DELAY(DL); V1:=V1+[I]; END; END; V0:=V0-V1; END; END; (*---------------------------------------*) PROCEDURE PROC_CALL_PROC; {THU TUC GOI CAC THU TUC} VAR KT:CHAR; BEGIN IF KEYPRESSED THEN REPEAT KT:=READKEY UNTIL NOT KEYPRESSED; REPEAT INIT_GRAPH; PRINT_GRAPH; MENU_PRINT; COLORING; KT:=READKEY; UNTIL (KT=#27); END; (*--------------------------------------*) BEGIN (* CHUONG TRINH CHINH *) CLRSCR; INITGR; V:=[]; FOR I:=1 TO N DO V:=V+[I]; PROC_CALL_PROC; CLOSEGRAPH; END. 8 h 54 m 28/7/2017 158 Thầy Trần Thông Quế VIII-2/ ĐỒ THỊ EULER & ĐỒ THỊ HAMILTON A) ĐỒ THỊ EULER 6- Liệt kê các đường đi Euler trên đồ thị vô hướng được biểu diễn bởi ma trận kề dưới đây: 9  Số đỉnh của đồ thị (Bắt buộc phải có dữ liệu này!) 0 1 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 0 0 1 0 CODE: Program Duongdi_Euler; uses crt; Label L1; Const max=30; Type mg1=array[1..max,1..max] of byte; mg2=array[1..max] of boolean; mg3=array[1..max] of integer; Var c:mg1; check:mg2; i,j,u,n,dem1,dem:integer; f:text; tf:string[12]; Function l_thg(u,v:integer; ktra:mg2):integer; var i,j,d,k,l:integer; p:mg3; Begin c[u,v]:=0; c[v,u]:=0; For i:=1 to n do p[i]:=0; d:=0; For i:=1 to n do Begin If (p[i]=0) and ktra[i] then Begin Inc(d); p[i]:=d; for j:=1 to n do for L:=1 to n do If (p[j]=0) and ktra[j] and (p[L]=d) and (c[L,j]=1) then p[j]:=d; End; End; c[u,v]:=1; c[v,u]:=1; L_thg:=d; End; 8 h 54 m 28/7/2017 159 Thầy Trần Thông Quế {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 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. 7- Tìm và hiển thị chu trình EULER trên đồ thị biểu diễn bởi danh sách liệt kê cạnh. Yêu cầu: Program phải chạy được cả với đồ thị vô hướng và đồ thị có hướng (đồ thị vô hướng: gõ 0; đồ thị có hướng: gõ 1). Test1: Dùng file vào DTEUL.IN 8 h 54 m 28/7/2017 160 Thầy Trần Thông Quế 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 B) ĐỒ THỊ HAMILTON 8- Tìm và hiển thị đường đi Hamilton trên đồ thị vô hướng được biểu diễn bởi danh sách liệt kê cạnh. 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 9/ (Bài này bạn thử test với ma trận kề của đồ thị) Tìm và liệt kê chu trình Hamilton trên đồ thị được 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 8 h 54 m 28/7/2017 161 Thầy Trần Thông Quế 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 n-1 Do If c[p[t],p[t+1]]=0 then Begin 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]); 8 h 54 m 28/7/2017 162 Thầy Trần Thông Quế 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 phi