100 đề Toán Tin Tin học & Nhà trường

ng} uses crt; const fi ='input.txt'; fo ='output.txt'; coso =100; type mg =array[-maxint..maxint]of byte; var L :array[1..3]of ^mg; n,lap :longint; kq :integer; time :longint; clock :longint absolute $00:$0046c; procedure tao_test; var f :text; k :longint; begin n:=1000000; assign(f,fi); rewrite(f); writeln(f,n); for k:=1 to N do if random(2)=1 then write(f,random(maxint),#32) else write(f,-random(maxint),#32); close(f); end; procedure danhdau(x:integer); var i :integer; begin for i:=3 downto 1 do if L[i]^[x]<coso then begin inc(L[i]^[x]); break; end else L[i]^[x]:=0; end; procedure lam; var f :text; k :longint; x :integer; begin for k:=1 to 3 do begin new(L[k]); fillchar(L[k]^,sizeof(L[k]^),0); end; assign(f,fi); reset(f); read(f,n); for k:=1 to n do begin read(f,x); danhdau(x); end; close(f); lap:=0; for k:=-maxint to maxint do if L[1]^[k]*sqr(coso)+L[2]^[k]*coso+L[3]^[k]>lap then begin lap:=L[1]^[k]*sqr(coso)+L[2]^[k]*coso+L[3]^[k]; kq:=k; end; for k:=1 to 3 do dispose(L[k]); end; procedure ghif; var f :text; begin assign(f,fo); rewrite(f); write(f,kq); writeln('So lan lap :',lap); close(f); end; BEGIN {tao_test;} time:=clock; lam; ghif; writeln((clock-time)/18.2:10:10); END. Bài 92/2002 - Dãy chia hết (Dành cho học sinh THPT) program DayChiaHet; uses crt; const inp='div.inp'; out='div.out'; var a:array[0..1] of set of byte; g:text; k,n,t,i,j,l:longint; function f(x:longint):byte; begin x:=x mod k; if x<0 then f:=x+k else f:=x; end; begin clrscr; assign(g,inp);reset(g); readln(g,n,k); t:=0; read(g,j); a[0]:=[f(j)]; for i:=2 to n do begin t:=1-t; a[t]:=[]; read(g,j); for l:=0 to k-1 do if l in a[1-t] then begin a[t]:=a[t]+[f(l+j)]; a[t]:=a[t]+[f(l-j)]; end; end; close(g); assign(g,out);rewrite(g); if 0 in a[t] then write(g,1) else write(g,0); close(g); write('Complete - Open file ',out,' to view the result'); readln; End. (Lời giải của bạn Vũ Lê An - 12T2 - Lê Khiết - Quảng Ngãi) Mở rộng bài toán: 1. Tìm dãy con liên tiếp có tổng bé nhất. 2. Tìm dãy con liên tiếp các phần tử thuộc dãy bằng nhau dài nhất. 3. Cho ma trận MxN hãy tìm hình chữ nhật có tổng lớn nhất (nhỏ nhất) với M,N<=100 4. Cho ma trận MxN hãy tìm hình chữ nhật có diện tích lớn nhất có các phần tử bằng nhau. Cách giải bài toán 2 giải giống với bài toán 1, bài toán 3 và 4 giải giống nhau dựa trên cơ sở bài 1,2. Cách giải bài toán 3: Xét hình các hình chữ nhật có toạ độ cột trái là i toạ độ cột phải là j (mất O(N2)). Coi mỗi dòng như một phần tử, để tìm hình chữ nhật có diện tích lớn nhất ta phải mất O(N) nữa. Như vậy độ phức tạp là O(N3). Bài 93/2002 - Trò chơi bắn bi (Dành cho học sinh Tiểu học) Có 3 đường đi đạt số điểm lớn nhất là: 32. Bài 94/2002 - Biểu diễn tổng các số Fibonaci (Dành cho học sinh THCS) Cách giải: Ta sẽ tìm số Fibonacci gần với số N nhất. Đây sẽ chính là số hạng đầu tiên nằm trong dãy kết quả. Sau đó, lấy hiệu của số N và số Fibonacci gần với số N nhất, tiếp tục tìm số Fib gần với hiệu trên và cứ thế cho đến khi hiệu đó là một số Fib. Kết quả các số Fibonacci sẽ được liệt kê theo thứ tự từ lớn đến nhỏ. Chương trình: Program BdFib;{Bai 94/2002: Bieu dien tong cac so Fibonacci} uses crt; var n:longint; f:array[1..1000] of longint; function fib(k:integer): longint; begin f[1]:=1; f[2]:=1; f[3]:=2; if f[k]=-1 then f[k]:=fib(k-1)+fib(k-2); fib:=f[k]; end; procedure xuly; var i,j:longint; begin for i:=1 to 1000 do f[i]:=-1; while n>0 do begin i:=1; while fib(i)<=n do inc(i); j:=fib(i-1); write(j,' + '); n:=n-j; end; gotoxy(wherex-2,wherey); writeln(' '); end; procedure test; begin clrscr; write('Nhap n='); readln(n); clrscr; write('n='); xuly; end; BEGIN test; readln; END. (Lời giải của bạn Cao Lê Thăng Long - Lớp 8E Nguyễn Trường Tộ - Hà Nội) Bài 95/2002 - Dãy con có tổng lớn nhất (Dành cho học sinh THPT) Program subseq; const inp = 'subseq.inp'; out = 'subseq.out'; var n, dau, cuoi, d:longint; max, T:longint; f, g:text; Procedure input; begin assign(f,inp); reset(f); assign(g,out); rewrite(g); Readln(f,n); End; Procedure solve; var i,j:longint; begin dau:=1; cuoi:=1; d:=1; max:=-maxlongint; T:=0; for i:=1 to n do begin readln(f,j); T:=T + j ; If T > max then begin max:=T; dau:=d; cuoi:=i; end; If T<0 then begin T:=0; d:=i+1; end; end; End; Procedure output; Begin writeln(g,dau); writeln(g,cuoi); writeln(g,max); Close(f); Close(g); End; BEGIN input; solve; output; END. (Lời giải của bạn Võ Xuân Sơn - Lớp 11A2 THPT Phan Bội Châu - Nghệ An) Bài 96/2002 - Số chung lớn nhất (Dành cho học sinh THPT) {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+} {$M 16384,0,655360} uses crt; const maxn = 251; fi = 'string.inp'; fo = 'string.out'; var pa : array[0..maxn,0..maxn] of byte; s1,s2,skq : string; max : byte; procedure docf; var f : text; begin assign(f,fi); reset(f); readln(f,s1); read(f,s2); close(f); end; function maxso(a,b:byte) : byte; begin maxso := (abs(a-b)+a+b) div 2; end; procedure Idonotknow; var i,j : byte; begin for i := length(s1) downto 1 do for j := length(s2) downto 1 do if s1[i] = s2[j] then pa[i,j] := pa[i+1,j+1] +1 else pa[i,j] := maxso(pa[i+1,j] , pa[i,j+1] ); max := pa[1,1]; end; procedure wastingtime; var ch : char; i,j,so,is,js : byte; begin is := 1; js := 1; so := 0; repeat for ch := '9' downto '0' do begin i := is; j := js; while (s1[i] ch)and(i <= length(s1)) do inc(i); while (s2[j] ch)and(j <= length(s2)) do inc(j); if pa[i,j] = max - so then begin skq := skq + ch; is := i+1; js := j+1; break; end; end; inc(so); until max=so; while (skq[1] = '0')and(skq'0') do delete(skq,1,1); end; procedure ghif; var f : text; begin assign(f,fo); rewrite(f); if max = 0 then write(f,' Khong co xau chung !!!...') else begin wastingtime; write(f,skq); end; close(f); end; BEGIN docf; idonotknow; ghif; END. Bài 97/2002 - Thay số trong bảng (Dành cho học sinh Tiểu học) 4 5 6 1 2 3 a b c d e f g h i Ngang 4 - Bội số nguyên của 8; 5 - Tích của các số tự nhiên liên tiếp đầu tiên; 6 - Tích các số nguyên tố kề nhau Dọc 1 - Bội nguyên của 11; 2 - Tích của nhiều thừa số 2; 3 - Bội số nguyên của 11. Giải: Từ (5) - Tích của các số tự nhiên đầu tiên cho kết quả là một số có 3 chữ số chỉ có thể là 120 hoặc 720 (1x2x3x4x5 = 120; 1x2x3x4x5x6 = 720). Do đó, (5) có thể là 120 hoặc 720. Suy ra: f = 0; e = 2; d = 1 hoặc d = 7. Tương tự, ta tìm được (6) có thể là 105 hoặc 385 (3x5x7 = 105; 5x7x11 = 385). Suy ra: i = 5; h = 0 hoặc h = 8; g = 1 hoặc g = 3. Từ (4) suy ra c chỉ có thể là số chẵn. Do f = 0, i = 5, từ (3) ta tìm được c = 6. Từ (2) - tích của nhiều thừa số 2 cho kết quả là một số có 3 chữ số chỉ có thể là một trong các số: 128, 256, 512. Mà theo trên e = 2 nên ta tìm được (2) là 128. Vậy b = 1, h = 8, g = 3. Từ (4) - Bội số nguyên của 8, do đó ta có thể tìm được (4) có thể là một trong các số: 216, 416, 616, 816. Tức là, a có thể bằng 2, 4, 6, hoặc 8. Kết hợp với (1), giả sử d = 1, như vậy ta không thể tìm được số nào thoả mãn (1). Với d = 7, ta tìm được a = 4 thoả mãn (1). Vậy a = 4, b = 1, c = 6, d = 7, e = 2, f = 0, g = 3, h = 8, i = 5. Và ta có kết quả như sau: 4 1 6 7 2 0 3 8 5 Bài 100/2002 - Mời khách dự tiệc (Dành cho học sinh THPT) program Guest; const Inp = 'Guest.inp'; Out = 'Guest.out'; var n: Integer; lSum: LongInt; t, v, p, Pred, Ind: array[0..1005] of Integer; Value: array[0..1005] of LongInt; Ok: array[0..1005] of Boolean; procedure ReadInput; var hFile: Text; i: Integer; begin Assign(hFile, Inp); Reset(hFile); Readln(hFile, n); for i := 1 to n do Readln(hFile, t[i], v[i]); Close(hFile); end; procedure QuickSort(l, r: Integer); var i, j, x, tg: Integer; begin i := l; j :=r; x := p[(l + r) div 2]; repeat while t[p[i]] < t[x] do Inc(i); while t[p[j]] > t[x] do Dec(j); if i <= j then begin tg := p[i]; p[i] := p[j]; p[j] := tg; Inc(i); Dec(j); end; until i > j; if i < r then QuickSort(i, r); if j > l then QuickSort(l, j); end; procedure Prepare; var i, j: Integer; begin FillChar(Value, SizeOf(Value), 0); FillChar(Ok, SizeOf(Ok), False); lSum := 0; for i := 1 to n + 1 do p[i] := i; t[n + 1] := n + 1; QuickSort(1, n); j := 2; Ind[0] := 1; for i := 1 to n do begin while t[p[j]] = i do Inc(j); Ind[i] := j - 1; end; end; function View(n: Integer): LongInt; var i, j: Integer; lSum1, lSum2: LongInt; begin lSum1 := 0; lSum2 := v[n]; for i := Ind[n - 1] + 1 to Ind[n] do begin if Value[p[i]] = 0 then Value[p[i]] := View(p[i]); lSum1 := lSum1 + Value[p[i]]; for j := Ind[p[i] - 1] + 1 to Ind[p[i]] do begin if Value[p[i]] = 0 then Value[p[i]] := View(p[j]); lSum2 := lSum2 + Value[p[j]]; end; end; if lSum1 > lSum2 then begin View := lSum1; Pred[n] := n - 1; end else begin View := lSum2; Pred[n] := n - 2; end; end; procedure Calculator(n: Integer); var i, j: Integer; begin if Pred[n] = n - 2 then begin Ok[n] := True; Inc(lSum); for i := Ind[n - 1] + 1 to Ind[n] do for j := Ind[p[i] - 1] + 1 to Ind[p[i]] do Calculator(p[j]) end else for i := Ind[n - 1] + 1 to Ind[n] do Calculator(p[i]) end; procedure WriteOutput; var hFile: Text; i: Integer; sView: LongInt; begin Assign(hFile, Out); Rewrite(hFile); sView := View(p[1]); Calculator(p[1]); Writeln(hFile, lSum, ' ', sView); for i := 1 to n do if Ok[i] then Writeln(hFile, i); Close(hFile); end; begin ReadInput; Prepare; WriteOutput; end. =========================== The End ============================