Tài liệu bồi dưỡng học sinh giỏi môn Tin học Lớp 11 - Đệ quy

Nội dung text: Tài liệu bồi dưỡng học sinh giỏi môn Tin học Lớp 11 - Đệ quy

1. while v[i] n then begin inc(d); hien; end; if i max) then exit; assign(f,fo); rewrite(f); d := 0; backtracking; if d=0 then hienvn; close(f); END. Bài 6 : Tìm từ chân chính ( chỉ gồm các kí tự thuộc tập A=[‘1’ ’9’] , không có 2 xâu con liền nhau bằng nhau ) sao cho độ dài của từ bằng số nguyên N ( N <= 40000 ) và ký tự C thuộc tập A chỉ xuất hiện không quá K lần . uses crt; const maxn = 40000; fo = 'pureword.out'; var w : array[1 maxn] of byte; n,k,dem : longint; len : byte; sok : longint; kituc : Byte; procedure init; var i : longint;
2. writeln(f); end; procedure sum; var i : longint; begin if dem>0 then write(f,'tong so nghiem la : ',dem) else write(f,'vo nghiem'); end; { tim tat ca cac nghiem } begin assign(f,fo); rewrite(f); repeat if k>n {dich} then result; if k n (*dich*) then begin result;close(f);exit;end; if k<1 (*that bai*) then begin writeln(f,'vo nghiem ');close(f);exit;end; if coduong and (k<=n) then inc(k) (*tien*) else (*lui*) begin w[k] := 0; dec(k); end; until false; close(f); end; } BEGIN clrscr; write('do dai cua tu chan chinh la N = '); readln(N); write('ki tu lap la : ');readln(kituc); write('so lan lap la : ');readln(sok); init; PW; END.
3. inc(i); dec(j); end; until i>j; if i dau then qs(dau,j); end; function duoc(k : integer) : boolean; var dau,cuoi : integer; i,p : integer; begin duoc:=true; fillchar(dx,sizeof(dX),0); dau:=0; cuoi:=1; q[cuoi]:=k; dx[k]:=1; while dau<cuoi do begin inc(dau); k:=q[dau]; for i:=1 to m do if k mod a[i]=0 then begin p:=k div a[i]; if dx[p]=0 then begin inc(cuoi); q[cuoi]:=p; dx[p]:=1; end; if p=1 then exit; end; end; duoc:=false; end; procedure write_out; var i : integer; begin assign(f,fo); rewrite(F); writeln(F,m); for i:=1 to m do begin write(f,a[i] : 5); if i mod 16 =0 then writeln(F); end; close(f); end; procedure thuchien; var i : integer; begin qs(1,n); m:=1; for i:=2 to n do if not duoc(a[i]) then Begin Inc(m); a[m]:=a[i]; end; write_out;
4. ucln := a; end; procedure taodothi; var i,j : integer; begin for i:=1 to n-1 do for j:=i+1 to n do if ucln(b[i],b[j]) k then if od_ngoai(A) then hien; else { i<=k } for j:=A[i-1]+1 to N-k+i do begin A[i] := j; tao_on_dinh_ngoai(i+1);
5. Bài 7 : Bài toán sắp ba lô : Cho n đồ vật , đồ vật thứ i có trọng lượng là wi , giá trị là vi .Người ta xếp các đồ vật vào 1 chiếc va ly có sức chứa tối đa là limw . Hãy chọn những đồ vật nào xếp vào va ly để giá trị va ly là lớn nhất . Đây là bài toán tìm véc tơ x = (x1 , x2 , , xn ) với xi chỉ nhận giá trị 0,1 , sao cho xi .wi limw và xi .vi đạt max . { xep cac do vat vao va ly, moi loai chi chon toi da la 1 vat }uses crt;const mn = 100; mw = 300; fi = 'knapsack.inp'; fo = 'knapsack.out'; type tf = array[0 mn,0 mw] of integer; twv = array[1 mn] of integer; tkq = array[1 mn] of byte; var f : tf; g : text; w,v : twv; tong : integer; mt,luumt,n,limw : integer; procedure docf; var i,j : integer; f : text; begin assign(f,fi); reset(f); read(f,n,limw); for i:=1 to n do read(f,w[i]); for i:=1 to n do read(f,v[i]); close(f); end; procedure hienf; var i,j : integer; begin write(n,' ',limw);writeln; for i:=1 to n do write(w[i]:4);writeln; for i:=1 to n do write(v[i]:4);writeln; end; procedure taobang; var i,j : integer; function max2(x,y : integer) : integer; begin if x =0) then f[i,j] := max2(f[i-1,j],f[i-1,j-w[i]]+v[i]) else f[i,j] := f[i-1,j]; end; end; procedure timkq(i,j : Integer);
6. Nếu máy đi trước : Chọn quân số 1 ( vì A[1,1] = 1 ) , dồn người chơi phải chọn quân 2 hoặc 3 , do đó cột điểm tiếp theo là 1+2 =3 hoặc 1+3=4 . Trong các cột điểm 3 và 4 , đến lượt máy đi lại có số 1 , nên máy lại được chọn quân ở hàng nào đó có số 1 . . . Quá trình cứ như thế , cho đến khi sẽ dẫn tới tình trạng : sau khi người đi quân số 2 hoặc 3 thì tổng điểm là 9 đến lượt máy đi , máy úp quân số 1 , được tổng điểm là 10 . Máy thắng . Nếu máy đi sau : Rất có thể máy bị dồn vào tình trạng : nhận cột điểm không có số 1 . Khi đó máy phải úp quân nào đó để cột điểm mới có ít số 1 nhất , nghĩa là tạo ra tình thế bất lợi nhất cho người ( Máy hy vọng người chơi này này không biết qui luật , úp phải quân bài ở hàng 0 của cột điểm mới này) Vấn đề còn lại các em sẽ thắc mắc là : Làm thế nào có bảng phương án như vậy ? Lý do đơn giản là chúng ta lần ngược từ trạng thái kết thúc chắc thắng về trạng thái đầu . Cụ thể + Gán A[1,N-1] = 1 + Sau đó xây dựng dần các số 1 ở các cột điểm đ = N-2,N-3, ,1 theo qui tắc : Chọn số quân lần lượt là Sq = 1 M . Gọi số lượng số 1 ở cột đ+Sq là x ( với điều kiện x 0 then For k:=i to i+4 do For h := j to j+4 do Begin Gotoxy(h,k); Write(ch); End; Textcolor(14); End; Procedure Nhap; Begin Repeat Clrscr; Write('So diem toi da ( N<= 200), N = '); {$I-} Readln(N); {$I+} Until (Ioresult=0) and (N in [1 200]); Repeat Gotoxy(1,2); Write('So quan bai ( M<=12 ) , M = '); {$I-} Readln(M); {$I+} Until (Ioresult=0) and (M in [1 12]); End; Function Sl_dau(diem : Byte) : Byte; Var d,j : Byte;
7. Write('Tong so diem ',diem:6); Textcolor(14); End; Procedure May_choi; Var k,x : Byte; Begin { Tinh huong tot } For k:=1 to M do If (k Luu then If (SL_dau(k+diem) 1 then Dec(sq) Else sq := m; 'M' : If sq Luu) and (Ch=#13); Gotoxy(1,16);Write(' '); Gotoxy(1,16); Write('Ban vua up quan = ',sq); Inc(diem,sq); If Luu>0 then Ve(5,luu*6,char(219)); Luu := sq; Ve(5,luu*6,char(176)); Delay(1000); End; BEGIN
8. Begin Assign(f, Input); Reset(F); Readln(F, N); For i:=1 to N Do Read(f, T[i]); Readln(F); For i:=1 to N Do Read(f, C[i]); Readln(F); CLose(f); End; Procedure Solution1; Var i, Tmin : Longint; F : text; begin Tmin:=0; For i:=1 to N Do Tmin:=Tmin+ T[i]; Assign(F, Output); Rewrite(f); Writeln(F, Tmin); Close(F); End; Function Kiemtra(k : Integer) : boolean; { Tap Hop Co K cong Viec Co Thoa Man Hay Khong } Var i, Now, Sh : Longint; Begin Kiemtra:=False; Now:=0; For i:=1 to K Do Begin Sh:=Tt[i]; Now:=Now+ T[Sh]; If Now>C[Sh] THen Exit; End; Kiemtra:=True; end; Procedure Solution2; Var i,j, Coc : Integer; F : text; Begin { Sap Sep Theo C[i] } For i:=1 to N Do Tt[i]:=i; For i:=1 to N Do for j:=i+1 to N Do If C[ Tt[i] ]> C[ Tt[j]] Then Begin Coc:=Tt[i]; Tt[i]:=Tt[j]; Tt[j]:=Coc; End; Assign(f, Output); Append(f); If Kiemtra(N) Then WRiteln(F,'CO') Else WRiteln(F,'KHONG'); CLose(F); End; function ThoaMan : Boolean; Var i, j, Coc : Integer;
9. Bài 4 : Cho N công việc ,với mỗi công việc cho thời điểm bắt đầu có thể thực hiện , thời gian thực hiện , thời điểm tối đa phải kết thúc . Xếp lịch để thực hiện được nhiều công việc nhất . {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X+} {$M 16384,0,655360} Uses crt; Const Input ='Viec.Inp'; Output ='viec.out'; max =51; Type Kieu =Record dau,tg,cuoi : Integer; Tt : Byte; End; Mang =Array[0 max] of Kieu; Ta =Array[1 max] of Byte; Var a , kq, lkq: mang; Cx : Ta; N , maxviec, viec , conlai, time: Integer; Procedure Nhap; Var f : text; i : Byte; Begin Assign(f,Input); Reset(F); Readln(f,N); For i:=1 to N Do Readln(f,A[i].dau,a[i].tg,a[i].cuoi); CLose(F); End; Procedure Sapsep; {Sap xep theo thoi diem bat dau , tang dan } var i,j : Byte; Begin For i:=1 to N Do A[i].tt:=i; For i:=1 to N Do For j:=i+1 to N Do If A[i].dau>A[j].dau Then Begin A[max]:=A[i]; A[i]:=A[j]; A[j]:=A[max]; End; End; Function Ln(k,t : integer) : Integer; Begin if k>t Then ln:=k Else ln:=t; End; Procedure Lay(k : Byte); Var i : Byte; Begin Dec(conlai); Cx[k] := k; Inc(viec);
10. If Cx[i]=0 Then If ln(tg1,A[i].Dau)+A[i].Tg maxviec Then Perfect; IF ktcan Then Vet; time:=Tg; bo(i); End; End; Procedure Bailam; Begin Fillchar(Cx,Sizeof(Cx),0); maxviec:=0; viec:=0; Time:=0; Conlai:=N; Kq[0].Cuoi:=0; Vet; End; Procedure Hienkq; Var f : text; i : Byte; Begin Assign(F,Output); ReWrite(f); Writeln(F,maxviec); For i:=1 to maxviec Do Writeln(F,A[Lkq[i].tt].tt,' ',Lkq[i].dau,' ',Lkq[i].Cuoi); Close(F); End; Procedure Taofile; Var f :text; i,tg,dau,Cuoi : Integer; Begin Write('NHAP N = '); Readln(N); Randomize; Assign(F,Input); ReWrite(F); Writeln(f,N); For i:=1 to N Do Begin Dau:=Random(10); Cuoi:=Dau+Random(100); Tg:=Random(Cuoi-dau)+1; Writeln(F,Dau,' ',tg,' ',Cuoi); End; Close(f); End;
11. Procedure Lay(k:Byte); Var j : Byte; Begin Tien := Tien+A[k].Tien; D[k] := k; Conlai := Conlai-A[k].Tien; Inc(top); Q[top].Thoigian := Thoidiem; {Thoi gian truoc khi lam k } Thoidiem := Thoidiem+A[k].Thoigian; Q[top].Ten := k; Q[top].Ketthuc := Thoidiem; {Thoi gian sau khi lam k } For j:=1 to N do If (D[j]=0)And(A[j].Ketthuc Tongtien then Luu_KQ; If Can then Exit; Try; Thao(k); End;
12. const max=20; Max1=200; Fi='Thaygiao.inp'; Fo='Thaygiao.out'; Type mang=array[1 max,1 max] of integer; mang2=array[1 max1,1 max] of byte; mang3=array[1 max] of integer; Mang4=array[1 max1] of integer; Var A : mang; Lop,kq : mang2; dong,cot : mang3; TT : mang4; M,n,snc,sn : integer; Time : longint; F : text; Procedure read_inp; var i,j : integer; begin Assign(f,fi); reset(F); readln(f,m,n); for i:=1to m do Begin for j:=1 to n do read(f,A[i,j]); readln(F); end; Close(f); end; Function max_arr(var A:mang3; n : integer) : integer; var i,ma : integer; Begin ma:=0; for i:=1 to n do If A[i]>ma then Ma:=A[i]; Max_arr:=ma; end; Function Songay : integer; var d,c : integer; Begin d:=max_arr(dong,m); C:=max_arr(cot,n); If d>c then songay:=d else songay:=c; end; function Ok : boolean; var i,j : integer; Begin
13. end; try(sngay,sthay+1); end; Procedure Init_data; var i,j : integer; begin Fillchar(Lop,sizeof(lop),0); for i:=1 to m do Begin dong[i]:=0; For j:=1to n do Dong[i]:=Dong[i]+A[i,j]; end; for j:=1 to n do begin cot[j]:=0; for i:=1 to n do Cot[j]:=Cot[j]+A[i,j]; end; Snc:=songay; Fillchar(tt,sizeof(tt),0); end; Procedure Solution; begin init_data; try(1,1); end; BEGIN Clrscr; Time:=meml[0:$46C]; Read_inp; Solution; END. 5 4 2 0 0 0 0 1 1 0 1 0 1 0 1 1 1 1 0 0 0 1 Bài 7 : ( Bài 1 - thi quốc tế 1996 – Tại Hunggari ) Một nhà máy chạy một dây chuyền sản xuất . Có 2 nguyên công cần phải thực hiện đối với mỗi một sản phẩm theo trình tự sau : đầu tiên là nguyên công A , sau đó tới nguyên công B . Có một số máy để thực hiện từng nguyên công . Hình 1 chỉ ra cách tổ chức dây chuyền sản xuất hoạt động như sau : Băng chuyền vào : ( ( ( ( ( ( ( ( ( ( Các máy kiểu A :
14. Procedure ReadInput; { Global output variables: N, M, PTime } Var InFile: Text; i: Word; Begin Assign(InFile, 'input.txt'); Reset(InFile); ReadLn(InFile,N); ReadLn(InFile,M['A']); For i:=1 To M['A'] Do Read(InFile, PTime['A',i]); ReadLn(InFile); ReadLn(InFile,M['B']); For i:=1 To M['B'] Do Read(InFile, PTime['B',i]); Close(InFile); End {ReadInput}; Function Compute_Time(Op:Operation):Longint; {Computes the minimal time that is needed to perform operation Op on N jobs} { Global input variables: M, PTime } Var t,Processed:Longint; i:Word; Begin t:=0; Repeat Inc(t); Processed:=0; For i:=1 To M[Op] Do Processed:=Processed+(t Div PTime[Op,i]); Until Processed>=N; Compute_Time:=t; End;{Compute_Time} Function Finish(Op:Operation; t: Longint): Longint; { Finish(Op,t) is the number of jobs that are finished at time t according to the optimal schedule for single operation Op for N jobs. } { Global input variables: N, M, PTime } Var Res,UpTo: Longint; i: Word; Begin Res:=0; For i:=1 To M[Op] Do If (t Mod PTime[Op,i])=0 Then Inc(Res); { If the number of jobs that can be completed up to time t is more then N then decrease Res to the proper value. } UpTo:=0; For i:=1 To M[Op] Do UpTo:= UpTo+ (t-1) Div PTime[Op,i]; If Upto >= N Then Res:= 0 Else If Upto+Res>N Then Res:= N-UpTo; Finish:=Res; End {Finish}; Procedure Adjust; { Computes the delay time d when the first type B machine starts to work }
15. Var F : Text; i : Integer; Begin Assign(F,Fi); {$i-} Reset(F); {$I+} If IoResult<>0 then Begin Writeln('Loi Ffile '); Readln; Halt; End; Readln(F,N); Readln(F,M1); For i:=1 to M1 do Read(F,T1[i]); Readln(F); Readln(F,M2); For i:=1 to M2 do Read(F,T2[i]); Close(F); End; Function spht(X : Ta;m,tg : Integer):Integer; Var sp,i : Integer; Begin sp := 0; For i:= 1 to m do sp:=sp+tg div X[i]; spht := sp; End; Function Thoigian(X : Ta;m: Integer): Integer; Var tg,sp : Integer; Begin tg := 0; sp := 0; While sp<N do Begin Inc(tg); sp := spht(X,m,tg); End; Thoigian := tg; End; Procedure Tinh; Var i,x,tgb : Integer; Function Conthieu(tgthieu : Integer): Integer; Var lam,i : Integer; Begin conthieu := N - spht(T2,m2,tgb-tgthieu-1); End; Begin tgb := Thoigian(T2,m2); x := 0; For i:=0 to tgb-1 do While spht(T1,M1,i+x)<conthieu(i) do Inc(x); Tgb := Tgb+x; Writeln(F,Tgb); End; Procedure Lam; Var ds_caua : Integer; Begin
16. B,KqA,KqB,Kq,phu : Tb; Thcv : Set of Byte; Procedure TaoF; Var f : Text; k,p,i,j : Byte; TH : Set of Byte; Begin Assign(f,fi); Rewrite(f); Write('So cong viec n = ');Readln(n); Write('So nhom tho m = ');Readln(m); Writeln(f,n,' ',m); Randomize; For i:=1 to m do Begin Write(f,Random(10)+1,' '); TH := []; For j:=1 to n do Begin k := Random(n)+1; If Not (k in TH) then Begin TH := TH+[k]; Write(f,k,' '); End; End; Writeln(f); End; Close(f); End; Procedure Nhap; Var f : Text; i,j : Byte; Begin Assign(f,Fi); {$i-} Reset(f); {$i+} If (ioresult<>0) then Begin Write('Error file data ',fi,' .Enter to quit'); Readln; halt; End; Readln(f,n,m); For i:=1 to m do Begin Read(f,B[i]); While not Seekeoln(f) do Begin Read(f,j); A[i,j] := 1; End; Readln(f); End; Close(f); End; Function Dk_Can:Boolean;{= False : Có công việc không thể thuê nhóm nào làm được} Var i,j : Byte;
17. Function Chapnhan(i:Byte):Boolean;{True : Nhom i co kha nang lam cv chua co ai lam} Var j : Byte; Begin Chapnhan := True; For j:=1 to n do If (A[i,j]=1) and Not (j in Thcv) then Exit; Chapnhan := False; End; Procedure Vet(i:Byte); Begin If (Thcv=[1 n]) then Begin Toiuu; Exit; End; If ((Sn>=Ln) and (St>=Lt)) or (i=m+1) then Exit; If Chapnhan(i) then { Nhom i lam duoc cong viec ma nhom tho da tuyen khong the lam duoc} Begin Them_nhom(i); Kq[i]:=1; Vet(i+1); Loai_nhom(i); Kq[i]:=0; End; Vet(i+1); End; Procedure Khoitri; Var i : Byte; Begin Ln:=Max+1; Lt:=Max+1; St:=0; sn:=0; Thcv:=[]; For i:=1 to n do Phu[i]:=0; End; Procedure Hienkq; Var i : Byte; Begin Writeln('Dang chay chuong trinh '); Write('Phuong an thue it nhom nhat la : '); For i:=1 to n do If KqA[i]=1 then Write(i:4); Write(#10#13,'Phuong an thue it tho nhat la : '); For i:=1 to n do If KqB[i]=1 then Write(i:4); Writeln(#10#13,'Chuong trinh da chay xong ! '); End; Procedure Xuly; Begin If Not Dk_Can then Begin Writeln('Khong ton tai phuong an thue .Enter de thoat');
18. Var N,M,k : Byte; a : Ta; b,lb : Tb; G,Lg : Integer; Ok : Set of Byte; Procedure Input; Var Tf : String; f : Text; Ok : Boolean; i,j: Byte; Begin Repeat Write(#10#13,'Cho biet ten file du lieu : '); Readln(tf); {$i-} Assign(f,tf); Reset(f); {$i+} Ok:=Ioresult=0; If Not Ok then Begin Writeln('File loi hoac khong co file ten la :',tf); End; Until Ok and (tf =0) and (k 0) then Write('(',i,',',Lb[i],')'); Writeln(#10#13,'Tong so diem = ',lg); End;
19. động viên nào và những vận động viên ấy mỗi người thi đấu môn nào ? Uses Crt; Const Max = 100; Fi = 'Tongk.txt'; Fo = ''; Type Pt = Record d,c,gt : Byte; End; M1 = Array[1 Max*Max+1] of Pt; M2 = Array[1 Max] of Record d,c :Byte;End; Var B,LB : M1; M,N,k : Byte; Dx,Kq,Lkq : M2; Tong,LTong,csMax : LongInt; Procedure DocF; Var i,j : Byte; F : Text; Begin Assign(F,Fi); {$I-} Reset(F); {$I+} If IoResult B[L].gt do Inc(i); While B[j].gt<B[L].gt do Dec(j); If i<=j then Begin phu := B[i]; B[i] := B[j]; B[j] := phu;
20. Kq[i].c := c1; Chon(i+1,p+1); Dx[d1].d := 0; Dx[c1].c := 0; Tong := Luu; Kq[i].d := 0; Kq[i].c := 0; End; End; End; End; Procedure Inkq; Var i : Byte; F : Text; Begin Assign(F,Fo); ReWrite(F); Writeln(F,'k= ',k,' Tong = ',LTong); For i:=1 to k do Writeln(F,Lkq[i].d:2,' ',Lkq[i].c:2,' = ', LB[(Lkq[i].d-1)*N+Lkq[i].c].gt); Close(F); End; BEGIN Clrscr; Khoitri; DocF; Sapxep_dl; Chon(1,1); Inkq; END.