Bài 46/2000 - Đảo chữ cái

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X+,Y+}

{$M 16384,0,655360}

(*Du lieu vao: file 'inp.txt' voi cac tu khac nhau, moi tu ghi o mot dong;

Du lieu ra: file 'out.txt' *)

PROGRAM Sinh_hoan_vi;

USES Crt;

CONST

MAX = 100;

INP = 'inp.txt';

OUT = 'out.txt';

TYPE

STR = array[0..max] of char;

VAR

s :str;

f,g :text;

n :longint; { so luong tu}

time:longint ;

PROCEDURE Nhap_dl;

Begin

Assign(f,inp);

Assign(g,out);

Reset(f);

Rewrite(g);

Readln(f,n);

End;

PROCEDURE DocDay(var s:str);

Begin

Fillchar(s,sizeof(s),chr(0));

While not eoln(f) do

begin

s[0]:=chr(ord(s[0])+1);

read(f,s[ord(s[0])]);

end;

End;

PROCEDURE VietDay(s:str);

Var i :word;

Begin

For i:=1 to ord(s[0]) do Write(g,s[i]);

End;

PROCEDURE Sap_xep(l,r:word);{ giai thuat Quicksort}

Var i,j :word;

tg,tam :char;

Begin

i:=l;j:=r;

tg:=s[(l+r) div 2];

Repeat

While ord(s[i]) < ord(tg) do inc(i);

While ord(s[j]) > ord(tg) do dec(j);

If i<=j then

begin

tam:=s[i];

s[i]:=s[j];

s[j]:=tam;

inc(i);

dec(j);

end;

Until i>j;

If j>l then Sap_xep(l,j);

If i<r then Sap_xep(i,r);

End;

PROCEDURE Sinh_hv(s:str);

Var vti,vtj,i,j:word;

stop :boolean;

tam :char;

Begin

Writeln(g);

VietDay(s);

Repeat

Stop:=true;

For i:= ord(s[0]) downto 2 do

If s[i] > s[i-1] then

begin

vti:=i-1;

stop:=false;

For j:=ord(s[0]) downto vti+1 do

begin

If (ord(s[j])>ord(s[vti])) then

begin

vtj:=j;

break;

end;

tam:=s[vtj];

s[vtj]:=s[vti];

s[vti]:=tam;

For j:=1 to ((ord(s[0]) - (vti+1))+1) div 2 do

begin

tam:=s[vti+j];

s[vti+j]:=s[ord(s[0])-j+1];

s[ord(s[0])-j+1]:=tam;

end;

Writeln(g);

VietDay(s);

break;

end;

Until stop;

End;

PROCEDURE Xu_ly;

Var i:longint;

Begin

For i:=1 to n do

begin

DocDay(s);

readln(f);

Sap_xep(1,ord(s[0]));

Sinh_hv(s);

Writeln(g);

end;

Close(f);

Close(g);

End;

BEGIN

Nhap_dl;

Xu_ly;

END.

(Lời giải của bạn Nguyễn Việt Bằng - Lớp 10 Tin - Trường phổ thông Năng Khiếu - ĐHQG TPHCM)

Bài 47/2000 - Xoá số trên vòng tròn

Lời giải 1:

Program vd;

Uses crt;

Var s:array[1..2000] of integer;

i:integer;

Begin

Clrscr;

for i:=0 to 1999 do s[i]:=i+1;

s[2000]:=1;

i:=1;

repeat

s[i]:=s[s[i]];

i:=s[i];

until

s[i]=i;

writeln(i);

readln;

End.

(Lời giải của bạn: Hà Huy Luân)

Lời giải 2:

Program xoa_so;
Const N=2000;
Var x:integer;

Function topow(x:integer):integer;
Var P:integer;
Begin
P:=1;
Repeat
p:=p*2;
Until p>x;
topow:=p div 2;
End;

BEGIN

x:=1+2*(N-topow(N));
write(x);
END.

(Lời giải của bạn: Nguyễn Quang Trung - Lớp 12A Trường HERMANN GMEINER, Đà Lạt, Lâm Đồng)

Lời giải 3:

(* Thuat Giai Xu ly Bit *)

USES Crt;

CONST

Max = 2000;

VAR

A: array[0..(MAX div 8)] of byte;

so: word;

FUNCTION Laybit(i:word):byte;

Var k:word;

Begin

k:=i div 8;

i:=i mod 8;

Laybit:=(a[k] shr (7-i)) and 1;

End;

PROCEDURE Tatbit(i:word);

Var k:word;

Begin

k:=i div 8;

i:=i mod 8;

a[k]:=a[k] and (not (1 shl (7-i)));

End;

FUNCTION Tim(j:word):word;

Begin

While (laybit(j+1)=0) do

begin

If j=max-1 then j:=0

else inc(j);

end;

Tim:=j+1;

End;

PROCEDURE Xuly;

Var j,dem,i :word;

Begin

j:=1;dem:=0;

Fillchar(a,sizeof(a),255);

Tatbit(0);

Repeat

If j=max then j:=0;

j:=tim(j);

Tatbit(j);

inc(dem);

If j=max then j:=0;

j:=tim(j);

Until dem=max-1;

For i:=0 to (max div 8) do

If a[i]<>0 then break;

so:=i * (1 shl 3);

For i:=so to so+7 do

If Laybit(i)=1 then break;

so:=i;

Writeln(' SO TIM DUOC LA :',SO:4);

Writeln(' Press Enter to Stop.....');

readln;

End;

BEGIN

Clrscr;

Xuly;

END.

(Lời giải của bạn: Nguyễn Việt Bằng - Lớp 10 Tin - Phổ thông Năng Khiếu - ĐHQG.TPHCM)

Bài 48/2000 - Những chiếc gậy

(Dành cho học sinh THPT)

Program bai48;

Var x:array[0..10000] of word;

d,a:array[1..1000] of byte;

n,p,s,gtmax:word;

fi,fo:text;

ok:boolean;

Procedure Q_sort(l,k:word);

Var h,i,j,t:word;

Begin

h:=a[(l+k)div 2];i:=l;j:=k;

Repeat

While a[i]>h do inc(i);

While a[j]<h do dec(j);

If i<=j then

Begin

t:=a[i];a[i]:=a[j];a[j]:=t;

inc(i);dec(j);

End;

Until i>j;

if i<k then Q_sort(i,k);

if j>l then Q_sort(l,j);

End;

Procedure phan(var ok:boolean);

Var i,p1,j:word;

Begin

Fillchar(x,sizeof(x),0);x[0]:=1;

For i:=1 to n do

If (d[i]=0) then

For j:=p downto a[i] do

If (x[j]=0) and(x[j-a[i]]<>0) then

Begin

x[j]:=i;

if j=p then

Begin

j:=a[i];

i:=n;

End;

ok:=(x[p]<>0);

if ok then

Begin

p1:=p;

Repeat

d[x[p1]]:=1;

p1:=p1-a[x[p1]];

Until p1=0;

End;

Procedure chat(Var ok:boolean);

Var i:word;

Begin

Fillchar(d,sizeof(d),0);

Repeat

phan(ok);

Until not ok;

ok:=true;

for i:= n downto 1 do

if d[i]=0 then

Begin

ok:=false;

break;

End;

Procedure Tinh;

Begin

For p:=gtmax to s div 2 do

Begin

chat(ok);

if ok then

Begin

writeln(fo,p);

break;

End;

If not ok then

Writeln(fo,s);

End;

Procedure Start;

Var i:word;

Begin

assign(fi,'input.txt');reset(fi);

assign(fo,'output.txt');rewrite(fo);

While not seekeof(fi) do

Begin

Readln(fi,n);

if n<>0 then

Begin

gtmax:=0;s:=0;

for i:=1 to n do

Begin

Read(fi,a[i]);

s:=s+a[i];

if a[i]> gtmax then

gtmax:=a[i];

End;

Q_sort(1,n);

Tinh;

End;

Close(fi);Close(fo);

End;

Begin

Start;

End.

5 2 1 5 2 1 5 2 1

1 2 3 4

(Lời giải của bạn Tăng Hải Anh - Hải Dương - TP. Hải Phòng)

Bài 49/2001 - Một chút nhanh trí

(Dành cho học sinh Tiểu học)

Theo giả thiết khi chia A và lập phương của A cho một số lẻ bất kỳ thì nhận được số dư như nhau, tức là: A³ (mod N) = A (mod N), ở đây N số lẻ bất kỳ, chọn N lẻ sao cho N > A³ thì ta phải có A³= A suy ra A=1.

Vậy chỉ có số 1 thoả mãn điều kiện của bài toán.

Bài 50/2001 - Bài toán đổi màu bi

(Dành cho học sinh THCS và PTTH)

Program ba_bi;

Uses crt;

var v,x,d:integer;

BEGIN

Clrscr;

writeln('v x d ?(>=0)');

readln(v,x,d);

if ((v-x)mod 3 =0)and((x+d)*(v+d)<>0) then

while (v+x)<>0 do

begin

d:=d-1+3*((3*v*x)div(3*v*x-1));

x:=x+2-3*((3*x)div(3*x-1));

v:=v+2-3*((3*v)div(3*v-1));

writeln('>> ',v,' ',x,' ',d);

end

else writeln('Khong duoc !');

readln;

END.

(Lời giải của bạn:Nguyễn Quang Trung)

Bài 51/2001 - Thay thế từ

(Dành cho học sinh THCS và PTTH)

program thaythetu;

var

source,des:array[1..50]of string;

n:byte;

procedure init;

var

i:byte;

s:string;

f:text;

begin

assign(f,'input2.txt');

reset(f);

n:=0;

while not eof(f) do

begin

readln(f,s);

inc(n);

while (s<>'')and(s[1]=' ') do

delete(s,1,1);

if i>0 then

begin

i:=pos(' ',s);

des[n]:=copy(s,1,i-1);

while (i<=length(s))and(s[i]=' ') do

i:=i+1;

source[n]:=copy(s,i,length(s)-i+1);

end;

procedure replace;

var

f,g:text;

s:string;

i,k:byte;

begin

assign(f,'input1.txt');

reset(f);

assign(g,'kq.out');

rewrite(g);

while not eof(f) do

begin

readln(f,s);

for k:=1 to n do

for i:=1 to length(s)-length(des[k])+1 do

if des[k]=copy(s,i,length(des[k])) then

begin

delete(s,i,length(des[k]));

insert(source[k],s,i);

i:=i+length(source[k]);

end;

writeln(g,s);

end;

close(f);

close(g);

end;

begin

init;

replace;

end.

Bài 52/2001 - Xác định các tứ giác đồng hồ trong ma trận

(Dành cho học sinh THCS và PTTH)

uses crt;

var s,n,i,k,j,a1,a2,b1,b2:integer;

chon,mau:byte;

a:array[1..100,1..100]of integer;

{----------------------------}

procedure nhap;

begin

write('nhap n>=2:');readln(n);

for i:=1 to n do

for j:=1 to n do

begin

write('nhap a[',i,'j]:');

readln(a[i,j]);

end;

{----------------------}

procedure tinh;

begin

clrscr;

nhap;

s:=0;

for i:=1 to n-1 do

for j:=1 to n-1 do

if ((a[i,j]<a[i,j+1])and(a[i,j+1]<a[i+1,j+1])and(a[i+1,j+1]<a[i+1,j]))

or((a[i,j+1]<a[i+1,j+1])and(a[i+1,j+1]<a[i+1,j])and(a[i+1,j]<a[i,j]))

or((a[i+1,j+1]<a[i+1,j])and(a[i+1,j]<a[i,j])and(a[i,j]<a[i,j+1]))

or((a[i+1,j]<a[i,j])and(a[i,j]<a[i,j+1])and(a[i,j+1]<a[i+1,j+1]))

then inc(s);

writeln;

writeln('So luong tu giac dong ho la:',s);

readln;

end;

{-----------------}

procedure max;

var t:integer;

begin

writeln('Nhap n>=2:');readln(n);

i:=1;

a1:=1;a2:=n;

b1:=1;b2:=n;

mau:=0;

t:=0;

while i<=n*n do

begin

for k:=a1 to a2 do

begin

a[b1,k]:=i;

gotoxy(5*k,b1);

inc(mau);

if mau>15 then mau:=1;

textcolor(mau);

write(i);

delay(70);inc(i);

end;

for k:=b1+1 to b2+t do

begin

a[k,a2]:=i;

gotoxy(5*(a2),k);

inc(mau);

if mau>15 then

mau:=1;

textcolor(mau);

write(i);

delay(70);

inc(i);

end;

for k:=b2+t downto b1+1 do

begin

a[k,b2]:=i;

gotoxy(5*(b2-1),k);

inc(mau);

if mau>15 then mau:=1;

textcolor(mau);

write(i);

delay(70);

inc(i);

end;

for k:=a2-2 downto a1 do

begin

a[b1+1,k]:=i;

gotoxy(5*k,b1+1);

inc(mau);

textcolor(mau);

write(i);

delay(70);

inc(i);

end;

dec(a2,2);

dec(b2,2);

inc(t,2);

inc(b1,2);

end;

if n>2 then s:=3*(n-2) else s:=1;

writeln;writeln;

writeln('Bang dong ho max');writeln;

writeln('Voi ma tran vuong cap ',n,'thi so luong tu giac dong ho lon nhat la:',s);

readln;

End;

{------------------}

procedure min;

begin

clrscr;

writeln('n>=2:');readln(n);

i:=1;

b1:=1;

while i<=n*n do

begin

for k:=1 to n do

begin

a[b1,k]:=i;

inc(mau);

if mau>15 then mau:=1;

textcolor(mau);

gotoxy(5*k,b1);

write(i);

delay(70);

inc(i);

end;

inc(b1);

end;

writeln;writeln;writeln('Bang tren s co gia tri=0');

readln;

End;

{------------------------------}

BEGIN

Clrscr;

repeat

textcolor(white);

writeln('1:cau a (Tinh so luong S)');

writeln('2:cau b (Lap bang co S lon nhat)');

writeln('3:cau c (Lap bang co S nho nhat)');

writeln('4:thoat');

writeln('Chon chuc nang:');readln(chon);

case chon of

1: begin

clrscr;

tinh;

end;

2: begin

clrscr;

max;

end;

3: begin

clrscr;

min;

end;

end;{of Case}

clrscr;

until chon=4;

END.

(Lời giải của bạn:Nguyễn Việt Hoà)

Bài 53/2001 - Lập lịch tháng kỳ ảo

(Dành cho học sinh THCS và PTTH)

(* Tat ca cac lich deu la lich ki ao *)

Program bai 53;

uses crt;

Const out='lichao.out';

Type mang=array[1..6,1..7] of integer;

Var a:mang;

i,j,dem:integer;

s:real;

f:text;

(*--------------------------------------*)

PROCEDURE Viet;

Var i,j:integer;

Begin

inc(dem);

writeln(f,'Kha nang thu ',dem);

for i:=1 to 6 do

begin

for j:=1 to 7 do

if a[i,j]<>0 then write(f,a[i,j]:3)

else write(f,'':3);

writeln(f);

end;

writeln(f);

End;

(*------------------------------------------*)

PROCEDURE Laplich(k,t:integer);

Var i,j,i1:integer;

Begin

for i1:=k to t+k-1 do

begin

j:=i1 mod 7;

i:=i1 div 7;

if j=0 then

begin

j:=7;

dec(i);

end;

a[i+1,j]:=i1-k+1;

end;

viet;

End;

(*-------------------------------------------*)

PROCEDURE Xuli;

Var i,j,k,t:integer;

Begin

for k:=1 to 7 do

for t:=28 to 31 do

begin

fillchar(a,sizeof(a),0);

Laplich(k,t);

end;

End;

(*---------------------------------------------*)

BEGIN

clrscr;

assign(f,out);

rewrite(f);

dem:=0;

Xuli;

close(f);

END.

(Lời giải của bạn: Đỗ Ngọc Sơn)

Bài 54/2001 - Bạn hãy gạch số

(Dành cho học sinh Tiểu học và THCS)

Chúng ta viết ra 10 số nguyên tố đầu tiên:

                  2 3 5 7 11 13 17 19 23 29

là số có 16 chữ số, có thể chứng minh không khó khăn lắm rằng sau khi gạch đi 8 chữ số thì số nhỏ nhất có thể được là: 11111229; còn số lớn nhất có thể được là: 77192329. Thật vậy:

a. Gạch đi 8 chữ số, để số còn lại là một số có 8 chữ số là nhỏ nhất (giữ nguyên thứ tự ban đầu). Nhìn vào dãy số ở trên ta thấy số 1 là nhỏ nhất, có năm chữ số 1 và sau chữ số 1 thứ năm này lại còn nhiều hơn 3 chữ số khác nữa. Do đó, 5 chữ số đầu của số cần tìm chắc chắn phải là 5 chữ số 1. Lí luận tương tự, để tìm được 3 chữ số còn lại.

b. Tương tự như thế: chữ số 9 là lớn nhất, nhưng sau chữ số 9 đầu tiên lại chỉ còn lại 4 chữ số (mà ta cần giữ lại số có 8 chữ số), nên ta không thể chọn số 9 là chữ số đứng đầu trong 8 chữ số cần tìm. Chữ số lớn thứ hai là 7, có hai chữ số 7, tất nhiên ta chọn chữ số 7 đầu tiên (vì sau chữ số 7 thứ 2 chỉ còn lại 6 chữ số). Lí luận tương tự, ta tìm được chữ số thứ hai trong 8 chữ số cần tìm cũng là chữ số 7, và 6 chữ số còn lại phải tìm tất nhiên là 6 chữ số sau chữ số 7 này.

Bài 55/2001 - Bài toán che mắt mèo

(Dành cho học sinh THCS và PTTH)

Program Che_Mat_meo;

Uses crt;

Const td=200;

Var i,j,n:integer;

out:string;

f:text;

Procedure Xuli;

Begin

for i:=1 to n do

begin

gotoxy(15,i+3);

for j:=1 to n do

begin

if (odd(i))and(odd(j)) then

begin

textcolor(11);

if out<>'' then write(f,'M ')

else

begin

write('M ');

delay(td);

end;

end

else

begin

textcolor(14);

if out<>'' then write(f,'o ')

else

begin

write('o ');

delay(td);

end;

writeln(f);

end;

End;

BEGIN

Clrscr; textcolor(2);

Write('Nhap n= ');

Readln(n);

if n<=20 then out:=''

else

begin

out:='matmeo.inp';

writeln('Mo File meo.inp de xem ket qua');

end;

Assign(f,out);

Rewrite(f);

writeln(f,'(Chu M Ki hieu cho con meo, chu o ki hieu cho quan co)');

Xuli; writeln(f);

Writeln(f,'Tong cong co ',sqr((n+1) div 2),' con meo');

Close(f);

Readln;

END.

(Lời giải của bạn Đỗ Ngọc Sơn - Quảng Ninh)

Bài 56/2001 - Chia lưới

(Dành cho học sinh PTTH)

Program Chia_luoi ;

Uses Crt ;

Const Fi = 'LUOI.INP';

Fo = 'LUOI.OUT';

Var A : Array[1..20,1..20]Of Integer ;

B : Array[1..20,1..20]Of 0..1 ;

Px,Py: Array[1..4] Of ShortInt ;

M,N,S,S1,S2 : LongInt ;

F : Text ;

Procedure Read_Input ;

Var i,j :Integer;

Begin

Clrscr ; S:= 0 ;

Assign(F,Fi) ;Reset(F) ;

Readln(F,M,N);

For i:=1 to M do

Begin

For j:=1 to N do

Begin

Read(F,A[i,j]);

S:=S+A[i,j];

End;

Readln(F);

End;

Close(F);

End;

Procedure Innit ;

Begin

S1 := S div 2;

Px[1]:= 0 ;Px[2]:= 0 ;Px[3]:=1 ;Px[4]:=-1 ;

Py[1]:= 1 ;Py[2]:=-1 ;Py[3]:=0 ;Py[4]:= 0 ;

End ;

Procedure Write_Output ;

Var i,j :Integer;

Begin

Assign(F,Fo); ReWrite(F);

For i:=1 to M do

Begin

For j:=1 to N do

Write(F,B[i,j],' ');

Writeln(F);

End;

Close(F);Halt;

End;

Function Ktra(x,y : Integer) : Boolean ;

Begin

Ktra:= False ;

If (x in [1..M]) And (y in [1..N]) And

(B[x,y] = 0 ) Then Ktra := True ;

End;

Procedure Try(x,y:Integer ;Sum :LongInt);

Var i :Integer ;

Begin

For i:=1 to 4 do

If Ktra(x+Px[i],y+Py[i]) Then

Begin

x := x + Px[i] ;

y := y + Py[i] ;

Sum := Sum + A[x,y];

B[x,y] := 1;

If Sum = S2 Then Write_Output ;

Try(x,y,Sum) ;

Sum := Sum - A[x,y];

B[x,y] := 0;

x := x - Px[i] ;

y := y - Py[i] ;

End ;

End;

Procedure Run ;

Var i,j : Integer ;

Begin

Read_Input ;Innit ;

For i:=1 to M do

For j:=1 to N do

If A[i,j]>= S1 Then

Begin

Fillchar(B,SizeOf(B),0);

B[i,j]:=1;

Write_Output;

End ;

For S2 := S1 downto 1 do

Begin

Fillchar(B,SizeOf(B),0);

B[1,1]:=1;

Try(1,1,A[1,1]);

End;

BEGIN

Run;

END.

(Lời giải của bạn Lê Sơn Tùng - Vĩnh Phúc )

Bài 57/2001 - Chọn số

(Dành cho học sinh Tiểu học và THCS )

Giả sử có m số 1, n số -1 (m, n nguyên dương) theo giả thiết:

a) m + n = 2000, suy ra m, n cùng tính chẵn lẻ.

+ Nếu m chẵn, do đó n cũng chẵn, ta chọn ra m/2 số 1 và n/2 số -1.

+ Nếu m lẻ, n lẻ:

               m = 2k +1 = k + (k + 1)

n = 2q +1 = q + (q + 1)

Luôn có: k - q = (k+1) - (q+1), do đó ta sẽ chọn k số 1 và q số -1.

Vậy ta luôn có thể chọn ra các số thỏa mãn điều kiện của bài toán.

b) m + n = 2001 -> m và n không cùng tính chẵn lẻ.

+ Nếu m chẵn -> n phải là lẻ:

               m = 2k  = i + j (giả sử chọn i số 1, giữ lại j số 1)

n = 2q +1 = t + s (giả sử chọn t số -1, giữ lại s số -1)

Theo cách chọn này -> i, j phải cùng tính chẵn lẻ; t, s không cùng tính chẵn lẻ.

Giả sử i chẵn, j chẵn, t lẻ, s chẵn, do đó: i + t ¹ j + s, như vậy cách chọn này không thỏa mãn. Các trường hợp còn lại xét tương tự.

Do đó, với trường hợp này không thể có cách chọn nào thỏa mãn điều kiện của bài toán.

Bài 58/2001 - Tổng các số tự nhiên liên tiếp

(Dành cho học sinh THCS và PTTH)

Program bai58;

Uses crt;

var N:longint;

m,i,dem,a,limit:longint;

procedure Solve;

begin

Writeln('Chia so ',N,':');

limit:=trunc(sqrt(1+8*N)+1) div 2;

for m:=2 to limit-1 do

if ((N-m*(m-1) div 2) mod m =0) then

begin

a:=(N-m*(m-1) div 2) div m;

inc(dem);

writeln('+ Cach thu ',dem,' :');

for i:=a to a+m-1 do

begin

write(' ',i);

if (i-a+1) mod 10=0 then writeln;

end;

writeln;

end;

BEGIN

clrscr;

writeln('Nhap N: ');readln(N);

Solve;

if dem=0 then writeln('Khong the chia!')

else writeln('Co tat ca', dem,' cach chia!');

readln;

END.

(Lời giải của bạn Nguyễn Quốc Quân - Lớp 11 T₂ - Trường PTTH Lê Viết Thuật - Vinh)

Bài 59/2001 - Đếm số ô vuông

(Dành cho học sinh THCS và PTTH)

Uses crt;

Const Ngang = ‘ngang.inp’;

Doc = ‘doc.inp’;

Max = 100;

n: integer = 0;

count: integer =0;

Var f1,f2:text;

o,i,j:integer;

a,b,c:array[1..max] of boolean;

BEGIN

clrscr;

Assign(f1,ngang); Assign(f2,doc);

Reset(f1); Reset(f2);

While not eoln(f1) do

begin

Read(f1,o);

Inc(n);

If o=1 then a[n]:=true

else a[n]:=false

end;

Readln(f1);

for i:= 1 to n do

begin

for j:= 1 to n do

begin

Read(f1,o);

If o=1 then b[j]:=true

else b[j]:=false;

end;

Readln(f1);

for j:=1 to n+1 do

begin

Read(f2,o);

If o=1 then c[j]:=true

else c[j] := false

end;

Readln(f2);

for j:=1 to n do

begin

If (a[j] and b[j] and c[j] and c[j+1]) then

inc(count);

end;

a:=b;

end;

Close(f1); Close(f2);

Write('Co', count, ‘hinh vuong!’);

Readln;

END.

(Lời giải của bạn Nguyễn Chí Thức - Lớp 10A1 - Khối chuyên Toán Tin - ĐH Sư phạm Hà Nội)

Bài 60/2001 - Tìm số dư của phép chia

(Dành cho học sinh Tiểu học)

Vì 1976 và 1977 là 2 số nguyên liên tiếp nên nguyên tố cùng nhau, do đó số thoả mãn điều kiện của bài toán phải có dạng:

                        n = 1976*1977*k +76 (k là số nguyên)

nhưng 1976*1977 lại chia hết cho 39 nên phần dư của n khi chia cho 39 sẽ là 37 (= 76 - 39).

Bài 61/2001 - Thuật toán điền số vào ma trận

(Dành cho học sinh THCS và PTTH)

Program Bai61;

Uses crt;

Var a:array[2..250,2..250] of -1..1;

n,i,j:integer;

BEGIN

Write('Doc vao n:'); Readln(n);

Fillchar(a, sizeof (a), 0);

for i:=1 to n do

for j:=1 to n do

begin

If (i mod 2 <> 0) and (j mod 2 <> 0) then a[i,i] := 1;

If (i mod 2 = 0) and (j mod 2 = 0) then a[i,i] := -1;

end;

Writeln('Mang da dien la: ');

for i:=1 to n do

begin

for j:=1 to n do Write(a[i,j]:3);

Writeln;

end;

Write('Tong lon nhat la:');

If n mod 2 = 0 then Write(0) else Write(n);

Readln;

END.

(Lời giải của bạn Trương Đức Hạnh - 12 Toán Năng Khiếu - Hà Tĩnh)

Bài 62/2001 - Chèn Xâu

(Dành cho học sinh THCS và PTTH)

Do sơ xuất khi ra đề nên trong số các lời giải của bạn đọc gửi đến toà soạn, có thể các bạn đã hiểu đề bài theo 2 cách sau đây, ta coi như hai bài toán:

1. Nếu theo ví dụ, thì ta cần chèn dấu vào xâu (không cần đủ 9 số như trong xâu S, có thể bớt một số số cuối của xâu, nhưng phải theo thứ tự) để phép tính nhận được bằng M cho trước.

2. Ta không để ý đến ví dụ của đề ra, yêu cầu cần chèn dấu vào giữa các số trong xâu '123456789' để nhận được kết quả M cho trước.

Sau đây là lời giải của bạn Nguyễn Chí Thức (hiểu theo bài toán 1):

Program Bai62;

Uses crt;

Const fo = 'chenxau.out';

dau: array[1..3] of String[1]= ('', '-', '+');

s:array[1..9] of char=('1','2','3','4','5','6','7','8','9');

Var d:array[1..9] of String[1];

m:longInt;

f:text;

k:integer;

found:boolean;

Procedure Init;

Begin

Write('Cho M=');

Readln(m);

found:=false;

end;

Function tinh(s:string):longint;

Var i,t:longint;

code:integer;

Begin

i:=length(s);

While not(s[i] in ['-','+']) and (i>0) do dec(i);

val(copy(s,i+1,length(s)-i),t,code);

If i=0 then begin tinh:=t; exit; end

else

begin

delete(s,i,length(s)-i+1);

If s[i]='+' then tinh:=t+tinh(s);

If s[i]='-' then tinh:=tinh(s)-t;

end;

End;

Procedure Test(i:integer);

Var st:string; j:integer;

Begin

st:='';

For j:=1 to i do st:=st+d[j]+s[j];

If Tinh(st) = m then begin writeln(f,st); found:=true; end;

End;

Procedure Try(i:integer);

Var j:integer;

Begin

for j:=1 to 3 do

begin

d[i]:=dau[j]; Test(i);

If i<9 then try(i+1);

end;

End;

BEGIN

Clrscr;

Init;

Assign(f,fo);Rewrite(f);

for k:=1 to 2 do

begin

d[1]:=dau[k];

Try(2);

end;

If not found then write(f,'khong co ngiem');

Close(f);

END.

Từ lời giải trên của bạn Thức, để thoả mãn yêu cầu của bài toán 2, trong thủ tục Try cần sửa lại như sau:

Procedure Try(i:integer);

Var j:integer;

Begin

for j:=1 to 3 do

begin

d[i]:=dau[j];

If i<9 then try(i+1);

If i=9 then Test(i);

end;

End;

HỌC TẬP CON ĐƯỜNG DUY NHẤT ĐỂ VƯƠN TỚI THÀNH CÔNG

Thứ Hai, 7 tháng 12, 2015

lời giải 100 bài (tiếp theo)

Bài 52/2001 - Xác định các tứ giác đồng hồ trong ma trận

(Dành cho học sinh THCS và PTTH)

Bài 53/2001 - Lập lịch tháng kỳ ảo

(Dành cho học sinh THCS và PTTH)

Bài 55/2001 - Bài toán che mắt mèo

Bài 56/2001 - Chia lưới

Bài 57/2001 - Chọn số

(Dành cho học sinh Tiểu học và THCS )

Bài 58/2001 - Tổng các số tự nhiên liên tiếp

(Dành cho học sinh THCS và PTTH)

(Lời giải của bạn Nguyễn Quốc Quân - Lớp 11 T₂ - Trường PTTH Lê Viết Thuật - Vinh)

Bài 61/2001 - Thuật toán điền số vào ma trận

Không có nhận xét nào:

Đăng nhận xét

Thứ Hai, 7 tháng 12, 2015

lời giải 100 bài (tiếp theo)

Bài 52/2001 - Xác định các tứ giác đồng hồ trong ma trận

(Dành cho học sinh THCS và PTTH)

Bài 53/2001 - Lập lịch tháng kỳ ảo

(Dành cho học sinh THCS và PTTH)

Bài 55/2001 - Bài toán che mắt mèo

Bài 56/2001 - Chia l­ưới

Bài 57/2001 - Chọn số

(Dành cho học sinh Tiểu học và THCS )

Bài 58/2001 - Tổng các số tự nhiên liên tiếp

(Dành cho học sinh THCS và PTTH)

(Lời giải của bạn Nguyễn Quốc Quân - Lớp 11 T2­ - Trường PTTH Lê Viết Thuật - Vinh)

Bài 61/2001 - Thuật toán điền số vào ma trận

Không có nhận xét nào:

Đăng nhận xét

Bài 56/2001 - Chia lưới

(Lời giải của bạn Nguyễn Quốc Quân - Lớp 11 T₂ - Trường PTTH Lê Viết Thuật - Vinh)