Bài làm của bạn @lê chí hiếu(bạn được 2,1 điểm)

bài 1

program PTYN;
uses crt;
var a:array[1..100,1..100]of integer;
i,j,m,n:integer;
f1,f2:text;
Max, Min:Integer;
Kt:boolean;
Procedure XuatMang;
begin
For i:=1 to n do
begin
for j:=1 to m do
Write(a[i,j]:4);
Writeln;
end;
end;
Procedure MaxCot(l:Integer);
var p:Integer;
begin
Max:=A[1,l];
For p:=2 to n do
if A[p,l]>Max then Max:=A[p,l];
end;
Procedure MinHang(k:Integer);
var o:integer;
begin
Min:=A[k,1];
For o:=2 to n do
if A[k,o]<Min then Min:=A[k,o];
end;
begin
clrscr;
assign(f1,'ptyn.inp');
assign(f2,'ptyn.out');
reset(f1);rewrite(f2);
while not EOF(f1) do
begin
kt:=false;
readln(f1,n,m);
for i:=1 to n do
begin
for j:=1 to m do
Read(f1,a[i,j]);
readln(f1);
end;

for i:=1 to n do
begin
for j:=1 to n do
begin
MaxCot(j);
MinHang(i);
if Max=Min then
begin
Writeln(f2,'(',i,',',j,')');
kt:=true;
end;
end;
end;
If kt=false then Writeln(f2,'Khong co ptu yen ngua.');
end;
Close(f1); Close(f2);
Readln
End.

Bài 4

const fi='tvh.inp';

fo='tvh.out';

var n,d,dem,sl,s2cs,s3cs,s4cs,s5cs,s6cs,s7cs,k,i,d1:longint;

st,st1,stk:string;

f1,f2:text;

begin

assign(f1,fi); reset(f1);

assign(f2,fo); rewrite(f2);

readln(f1,n,k);

str(n,st);

d:=length(st);

case d of

1: write(9);

2: begin

sl:=n-9;

dem:=9+sl*2;

end;

3: begin

s2cs:=(99-10)+1;

s3cs:=n-99;

dem:=9+s2cs*2+s3cs*3;

end;

4: begin

s2cs:=(99-10)+1;

s3cs:=(999-100)+1;

s4cs:=n-999;

dem:=9+s2cs*2+s3cs*3+s4cs*4;

end;

5: begin

s2cs:=(99-10)+1;

s3cs:=(999-100)+1;

s4cs:=(9999-1000)+1;

s5cs:=n-9999;

dem:=9+s2cs*2+s3cs*3+s4cs*4+s5cs*5;

end;

6: begin

s2cs:=(99-10)+1;

s3cs:=(999-100)+1;

s4cs:=(9999-1000)+1;

s5cs:=(99999-10000)+1;

s6cs:=n-99999;

dem:=9+s2cs*2+s3cs*3+s4cs*4+s5cs*5+s6cs*6;

end;

7: begin

s2cs:=(99-10)+1;

s3cs:=(999-100)+1;

s4cs:=(9999-1000)+1;

s5cs:=(99999-10000)+1;

s6cs:=(999999-1000000)+1;

s7cs:=n-999999;

dem:=9+s2cs*2+s3cs*3+s4cs*4+s5cs*5+s6cs*6+s7cs*7;

end;

end;

if k<=dem then

begin

i:=1;

d1:=0;

repeat

str(i,st1);



d1:=d1+length(st1);

i:=i+1;

until d1>=k;

stk:=st1[length(st1)-(d1-k)];

writeln(f2,stk);

end;

close(f1);

close(f2);

end.

Bài 5

PROGRAM robot;

VAR A:ARRAY[0..30,0..30] OF BYTE;

F:ARRAY[0..30,0..30] OF LONGINT;

m,n:INTEGER;

PROCEDURE Enter;

VAR i,j:INTEGER;

BEGIN

readln(m,n);

FOR i:=1 TO m DO

BEGIN

FOR j:=1 TO n DO read(A[i,j]);

readln;

END;

FOR i:=0 TO m DO A[i,0]:=-1;

FOR j:=0 TO n DO A[0,j]:=-1;

END;

FUNCTION Max(a,b:LONGINT):LONGINT;

BEGINIF (a>b) THEN Max:=a ELSE Max:=b;

END;

PROCEDURE Optimize;

VAR i,j:INTEGER;

BEGIN

FOR i:=0 TO m DO F[i,0]:=-1;

FOR j:=0 TO n DO F[0,j]:=-1;

F[0,1]:=0;

FOR i:=1 TO m DO

FOR j:=1 TO n DO

F[i,j]:=2*Max(F[i,j-1],F[i-1,j])+A[i,j];

END;

PROCEDURE Trace(i,j:INTEGER);

BEGINIF (i=1) AND (j=1) THEN

writeln(F[m,n])

ELSE

BEGIN

IF F[i,j-1]>F[i-1,j] THEN

Trace(i,j-1)

ELSE

Trace(i-1,j);

writeln(i,' ',j);

END;

END;

BEGIN

Assign(Input,'Robot.inp'); Reset(Input);

Assign(Output,'Robot.out');Rewrite(Output);

Enter;

Optimize;

Trace(m,n);

close(Input);

close(Output);

END.

Em hiểu,nhưng cách anh chỉ đến 8 chữ số là cùng.

Cách em thì chỉ cần lấy int64(em dùng luôn mấy biến real vì bự hơn) thì chấp 10^30

Tran Nguyễn Đăng Dương : lớp 7 mà bạn học Pascal rồi à :o

Em học từ hồi lớp 6 rồi

em có hiểu cách anh làm hay không?

Dạ vâng

Tức là cô nói em là đăng đáp án của từng bạn lọt vào vòng 2 ở dưới cmt đúng không ạ?

Đúng rồi, đăng như vậy để các bạn tiện theo dõi

Đăng vào chỗ trả lời giống như bt em vẫn giải bài đó

Dạ vâng, em sẽ làm ngay

bạn này được 7 điểm

Bài làm của bạn @Canh Toan Le(bạn này được 20 điểm tối đa)

Câu 1

const
fi='PTYN.INP';
fo='PTYN.OUT';
var m,n,i,j:longint;
a:array[1..105,1..105] of longint;
hang,cot:array[1..105] of longint;
begin
assign(input,fi);
reset(input);
readln(m,n);
for i:=1 to 105 do
hang[i]:=maxlongint;
for i:=1 to m do
for j:= 1 to n do
read(a[i,j]);
close(input);
for i:=1 to n do
for j:=1 to m do
if a[i,j]<hang[i] then hang[i]:=a[i,j];
for j:=1 to m do
for i:=1 to n do
if a[i,j]>cot[j] then cot[j]:=a[i,j];
assign(output,fo);
rewrite(output);
for i:=1 to m do
for j:=1 to n do
if (a[i,j]=hang[j]) and (a[i,j]=cot[i]) then
begin
write(i,' ',j);
exit;
end;
write('Khong co phan tu yen ngua');
close(output);
end.

Câu 2

const
fi='CONNECT.INP';
fo='CONNECT.OUT';
var n,i,j:longint;
a:array[1..10000] of string;
tmp:string;
function ss(x,y:string):boolean;
var t1,t2:int64;
begin
val(x+y,t1);
val(y+x,t2);
if t1<t2 then exit(true);
exit(false);
end;
begin
assign(input,fi);
reset(input);
readln(n);
for i:=1 to n do
readln(a[i]);
close(input);
for i:=1 to n-1 do
for j:=i+1 to n do
if ss(a[i],a[j]) then
begin
tmp:=a[i];
a[i]:=a[j];
a[j]:=tmp;
end;
assign(output,fo);
rewrite(output);
for i:=1 to n do write(a[i]);
close(output);
end.

Câu 3

const
fi='QUEDIEM.INP';
fo='QUEDIEM.OUT';
var n,i:longint;
a:array[0..9] of byte = (6,2,5,5,4,5,6,3,7,6);
function check(x:longint):boolean;
var s,t:int64;
begin
s:=0;
while x>0 do
begin
t:=x mod 10;
s:=s+a[t];
x:=x div 10;
end;
exit(s=n);
end;
begin
assign(input,fi);
reset(input);
readln(n);
close(input);
assign(output,fo);
rewrite(output);
if n mod 2= 0 then
for i:=1 to n div 2 do write(1)
else
begin
write(7);
for i:=1 to (n-3) div 2 do write (1);
end;
write('-');
for i:=1 to 100000000 do
if check(i) then begin write(i); exit;end;
close(output);
end.

Câu 4

const
fi='TVH.INP';
fo='TVH.OUT';
var n,i,k:longint;
s,t:ansistring;
begin
assign(input,fi);
reset(input);
readln(n,k);
close(input);
for i:=1 to n do
begin
str(i,t);
s:=s+t;
if length(s)>k then break;
end;
assign(output,fo);
rewrite(output);
write(s[k]);
close(output);
end.

Câu 5

const
fi='ROBOT.INP';
fo='ROBOT.OUT';
var n,i,j:longint; c:char;
a,dp:array[0..55,0..55] of string;
b:array[0..55,0..55] of byte;
begin
assign(input,fi);
reset(input);
readln(n);
for i:=1 to n do
for j:=1 to n do
read(b[i,j]);
for i:=1 to n do
for j:=1 to n do
a[i,j]:=chr(b[i,j]+48);
close(input);
for i:=1 to n do
begin
dp[1,i]:=dp[1,i-1]+a[1,i];
dp[i,1]:=dp[i-1,1]+a[i,1];
end;
for i:=2 to n do
for j:=2 to n do
if dp[i-1,j]>dp[i,j-1] then
dp[i,j]:=dp[i,j-1]+a[i,j]
else
dp[i,j]:=dp[i-1,j]+a[i,j];
assign(output,fo);
rewrite(output);
write(dp[n,n]);
close(output);
end.

Bài làm của bạn @Encyclopedia(bạn này được 20 điểm tối đa)

Bài 1//

type mang=array[1..100,1..100] of integer;
var f,g:Text;
a:mang;
m,n,j,i,yn,o,l:integer;
kt:boolean;
const
fi='PTYN.INP';
fo='PTYN.OUT';
procedure nhap;
begin
assign(f,fi); reset(f);
assign(g,fo); rewrite(G);
read(f,m,n);
for i:=1 to n do
begin
for j:=1 to m do
read(f,a[i,j]);
readln(f);
end;
i:=0;
j:=0;
end;
procedure xuly;
var k,max,min,p:integer;
b:array[1..100] of integer;
begin
k:=0;
i:=i+1;
p:=i;
for j:=1 to m do
begin
k:=k+1;
b[k]:=a[i,j];
end;
min:=b[1];
for i:=2 to k do
if min>b[i] then begin min:=b[i]; j:=i; end;
k:=0;
for i:=1 to n do
begin
k:=k+1;
b[k]:=a[i,j];
end;
max:=b[1];
for i:=2 to k do
if max<b[i] then begin max:=b[i]; l:=i; end;
if min=max then kt:=true
else kt:=false;
i:=p;
min:=0;
max:=0;
end;
procedure xuat;
begin
if kt=true then write(g,j,' ',l)
else write(g,'Khong co phan tu yen ngua');
close(f);
close(g);
end;
begin
nhap;
o:=0;
while o<>n*m do
begin
o:=o+1;
xuly;
if kt=true then break;
end;
xuat;
end.

bài 2//

type mang=array[1..1000] of longword;
var f,g:Text;
n, x: longword;
i, j: longword;
a: mang;
const
fi='CONNECT.INP';
fo='CONNECT.OUT';
function tongthiln(a, b: longword): boolean;
var s,s1: string;
begin
str(a, s);
str(b, s1);
exit(s+s1>= s1 + s);
end;
begin
assign(f, fi); reset(f);
assign(g,fo); rewrite(g);
read(f,n);
for i := 1 to n do begin
j := i;
read(f, a[j]);
while (j > 1) and (not tongthiln(a[j - 1], a[j])) do begin
x := a[j];
a[j] := a[j - 1];
a[j - 1] := x;
dec(j);
end;
end;
for i := 1 to n do
write(g, a[i]);
close(F);
close(g);
end.

Bài 3//

var f,g:text;
n: integer;
a: array[1..7] of integer = (0, 1, 2, 4, 6, 7, 8);
b: array[1..7] of integer = (6, 2, 5, 4, 6, 3, 7);
const
fi='QUEDIEM.INP';
fo='QUEDIEM.OUT';
procedure input;
begin
assign(f,fi); reset(f);
assign(g,fo); rewrite(g);
read(f,n);
end;
procedure solonnhat(x: integer);
begin
if x mod 2 = 1 then begin
write(g, 7);
dec(x, 3);
end;
write(g, stringofchar('1', x div 2));
end;
procedure sonhonhat(x: integer);
var s, i, l: integer;
begin
s := (x + 6) div 7;
if s = 1 then l:= 0
else l := 1;
while s <> 0 do
for i := l + 1 to 7 do
if (x - b[i] >= 2*(s - 1)) and (x - b[i] <= 7*(s - 1)) then begin
write(g, a[i]);
dec(x, b[i]);
dec(s);
l := 0;
break;
end;
end;
procedure output;
begin
solonnhat(n);
write(g,'-');
sonhonhat(n);
close(f);
close(g);
end;
begin
input;
output;
end.

Bài 4//

var n,k,i:longint;
s,s1:ansistring;
f,g:text;
const
fi='TVH.INP';
fo='TVH.OUT';
begin
assign(f,fi); reset(f);
assign(g,fo); rewrite(g);
readln(f,n,k);
for i:=1 to n do
begin
str(i,s1);
s:=s+s1;
if length(s)>k then break;
end;
write(g,s[k]);
close(f);
close(g);
end.

Bài 5//

var f,g:Text;
n, x: integer;
i, j: integer;
a: array[1..50, 1..50] of string;
const
fi='ROBOT.INP';
fo='ROBOT.OUT';
procedure input;
begin
assign(f,fi); reset(f);
assign(g,fo); rewrite(g);
readln(f, n);
end;
function min(a, b: string): string;
begin
if a <= b then
exit(a);
exit(b);
end;
procedure xuly;
begin
for i := 1 to n do
for j := 1 to n do begin
read(f, x);
str(x, a[i][j]);
end;
for i := 2 to n do begin
a[1, i] := a[1, i - 1] + a[1, i];
a[i, 1] := a[i - 1, 1] + a[i, 1];
end;
for i := 2 to n do
for j := 2 to n do
a[i, j] := min(a[i - 1, j], a[i, j - 1]) + a[i, j];
write(g, a[n, n]);
close(f);
close(g);
end;
begin
input;
xuly;
end.

Bài làm của bạn @Tran Nguyễn Đăng Dương(bạn này được 20 điểm tối đa)

Bài 1:

Program phantuyenngua;
uses crt;
const fi='PTYN.inp';
fo='PTYN.out';
var a:array[0..1000,0..1000] of Longint;
i,j,n,m,min,max,tg,t,vtc,vtd,dem:longint;
f1,f2:text;
kt:byte;
Begin
clrscr;
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
readln(f1,n,m);
for i:=1 to n do
begin
for j:=1 to m do read(f1,a[i,j]);
end;
dem:=0;
for i:=1 to n do
begin
vtd:=i;
vtc:=1;
min:=a[i,1];
for j:=2 to m do
if min>a[i,j] then
begin
min:=a[i,j];
vtd:=i;
vtc:=j;
end;
max:=min;
kt:=0;
for t:=1 to n do if max<a[t,vtc] then kt:=1;
if kt=0 then begin
writeln(f2,vtd,' ',vtc);
dem:=dem+1;
end;
end;
if dem=0 then writeln(f2,'Khong co phan tu yen ngua');
close(f1);
close(f2);
End.

Bài 2:

Program connect;
uses crt;
const fi='connect.inp';
fo='connect.out';
type num=record
number,top:integer;
end;
var a:array[0..1000] of num;
t:num;
i,n,j:integer;
f1,f2:text;
Function timtop(a:integer):integer;
begin
if a<10 then exit(a);
exit(timtop(a div 10));
end;
Begin
clrscr;
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
read(f1,n);
for i:=1 to n do
begin
read(f1,a[i].number);
a[i].top:=timtop(a[i].number);
end;
for i:=1 to n-1 do
for j:=i+1 to n do
begin
if a[i].top=a[j].top then
begin
if a[i].number>a[j].number then
begin
t:=a[i];
a[i]:=a[j];
a[j]:=t;
end;
end
else if a[i].top<a[j].top then
begin
t:=a[i];
a[i]:=a[j];
a[j]:=t;
end;
end;
for i:=1 to n do write(f2,a[i].number);
Close(f1);
Close(f2);
End.

Bài 3:

Program quediem;
uses crt;
const fi='quediem.inp';
fo='quediem.out';
type chuso=Record
ChuSo,SoQueDiem:integer;
end;
var cacchuso:array[1..7] of chuso
=((ChuSo : 0 ; SoQueDiem : 6 ), (ChuSo : 1 ; SoQueDiem : 2 ),
(ChuSo : 2 ; SoQueDiem : 5 ), (ChuSo : 4 ; SoQueDiem : 4 ),
(ChuSo : 6 ; SoQueDiem : 6 ), (ChuSo : 7 ; SoQueDiem : 3 ),
(ChuSo : 8 ; SoQueDiem : 7 ));
st,sttam:string;
n,i,luachon,scs,dem,sqd,tam,j,scs1:integer;
f1,f2:text;
Begin
clrscr;
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
read(f1,n);
st:='';
if n mod 2=0 then
begin
for i:=1 to n div 2 do
st:=st+'1';
end
else if n mod 2=1 then
begin
st:='7';
for i:=1 to (n-3) div 2 do
st:=st+'1';
end;
write(f2,st,'-');
scs:=(n div 7)+1;
if n mod 7=0 then scs:=scs-1;
tam:=scs;
sqd:=n;
dem:=0;
repeat
dem:=dem+1;
if dem=1 then
for i:=1 to 7 do
begin
if (scs>1) and (i=1) then continue;
scs1:=((sqd-cacchuso[i].SoQueDiem) div 7)+1;
if (sqd-cacchuso[i].SoQueDiem) mod 7=0 then scs1:=scs1-1;
if scs1=scs-dem then
begin
sqd:=sqd-cacchuso[i].SoQueDiem;
write(f2,cacchuso[i].ChuSo);
break;
end;
end
else
for j:=1 to 7 do
begin
scs1:=((sqd-cacchuso[j].SoQueDiem) div 7)+1;
if (sqd-cacchuso[j].SoQueDiem) mod 7=0 then scs1:=scs1-1;
if scs1=scs-dem then
begin
sqd:=sqd-cacchuso[j].SoQueDiem;
write(f2,cacchuso[j].ChuSo);
break;
end;
end;
until dem=scs;
Close(f1);
Close(f2);
End.

Bài 4:

Program thevanhoi;
uses crt;
const fi='tvh.inp';
fo='tvh.out';
var n,k,i,ld,lc,number:int64;
nod,place:integer;
f1,f2:text;
st:string;
Function tinhluythua(a,n:integer):LongInt;
Var i,tg:integer;
begin
if n=0 then exit(1);
exit(tinhluythua(a,n-1)*a);
end;
Function calculateC(m:integer):int64;
begin
if m=1 then exit(9);
exit(calculateC(m-1)+(9*m*tinhluythua(10,m-1)));
end;
Function rangeofnumber(d,c:int64; m:integer):integer;
begin
ld:=d; lc:=c;
if (d<=k) and (k<=c) then exit(m);
exit(rangeofnumber(c+1,calculateC(m),m+1));
end;
Begin
clrscr;
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
read(f1,n,k);
nod:=rangeofnumber(0,9,1)-1;
number:=tinhluythua(10,nod-1)+((k-ld+1) div nod);
place:=(k-ld+1) mod nod;
str(number,st);
writeln(f2,st[place]);
Close(f1);
Close(f2);
End.

Bài 5:

Program robot;
uses crt;
const fi='robot.inp';
fo='robot.out';
type path=record
num,npath:integer;
end;
var a:array[0..1000,0..1000] of path;
i,j,n:integer;
b,c:array[1..2] of Integer;
st,st1:string;
f1,f2:text;
check:boolean;
min:real;
Function he2sanghe10(st1:string):real;
var d,x,tg:integer;
stt:string;
begin
he2sanghe10:=0;
d:=Length(st1);
for i:=1 to d do
begin
stt:=st1[i];
Val(stt,x,tg);
he2sanghe10:=he2sanghe10*2+x;
end;
end;
Procedure robotpath(x,y:integer; st1:string);
var k:integer;
t:string;
S:real;
begin
if (x=n) and (y=n) then
begin
S:=0;
S:=he2sanghe10(st1);
if (min>S) then
begin
min:=S;
st:=st1;
end;
end
else
for k:=1 to 2 do
begin
if (x+b[k]>=1) and (y+c[k]>=1) and (x+b[k]<=n) and (y+c[k]<=n) then
begin
str(a[x+b[k],y+c[k]].num,t);
st1:=st1+t;
a[x+b[k],y+c[k]].npath:=a[x,y].npath+1;
robotpath(x+b[k],y+c[k],st1);
Delete(st1,Length(st1),1);
if (a[x+b[k],y+c[k]].npath=0) then break;
end;
end;
end;
Begin
clrscr;
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
b[1]:=1; c[2]:=1;
min:=99999999999999999999999999999999999999;
read(f1,n);
for i:=1 to n do
for j:=1 to n do
begin
read(f1,a[i,j].num);
a[i,j].npath:=n*n;
end;
a[1,1].npath:=1;
Str(a[1,1].num,st1);
robotpath(1,1,st1);
writeln(f2,st);
Close(f1);
Close(f2);
End.

Bài làm của bạn https://hoc24.vn/id/2720062(bạn này được 17 điểm)

// Bài 1 (PTYN).
var
min_row, max_col: array[1..100] of longint;
a: array[1..100, 1..100] of longint;
flag: boolean;
M, N: integer;
i, j: integer;
fi, fo: text;


procedure open_file(s: string);
begin
assign(fi, s + '.INP'); reset(fi);
assign(fo, s + '.OUT'); rewrite(fo);
end;
procedure close_file;
begin
close(fi);
close(fo);
end;


begin
open_file('PTYN');


readln(fi, M, N);


if (M = 0) or (N = 0) then begin
write(fo, 'Khong co phan tu yen ngua');
close_file;
exit;
end;


for i := 1 to M do min_row[i] := 1;
for j := 1 to N do max_col[j] := 1;


for i := 1 to M do
for j := 1 to N do begin
read(fi, a[i][j]);
if a[i][j] < a[i][min_row[i]] then
min_row[i] := j;
if a[i][j] > a[max_col[j]][j] then
max_col[j] := i;
end;


flag := true;
for i := 1 to M do
if max_col[min_row[i]] = i then begin
flag := false;
writeln(fo, i, ' ', min_row[i]);
end;


if flag then
write(fo, 'Khong co phan tu yen ngua');


close_file;
end.

// Bài 2 (CONNECT).
var
N, x: longint;
i, j: longint;
a: array[1..1000000] of longint;
fi, fo: text;


procedure open_file(s: string);
begin
assign(fi, s + '.INP'); reset(fi);
assign(fo, s + '.OUT'); rewrite(fo);
end;
procedure close_file;
begin
close(fi);
close(fo);
end;


function approved(a, b: longint): boolean;
var s1, s2: string;
begin
str(a, s1);
str(b, s2);
exit(s1 + s2 >= s2 + s1);
end;


begin
open_file('CONNECT');


read(fi, N);
for i := 1 to N do begin
j := i;
read(fi, a[j]);
while (j > 1) and (not approved(a[j - 1], a[j])) do begin
x := a[j];
a[j] := a[j - 1];
a[j - 1] := x;
dec(j);
end;
end;


for i := 1 to N do
write(fo, a[i]);


close_file;
end.

// Bài 3 (QUEDIEM).
var
n: integer;
a: array[1..7] of integer = (0, 1, 2, 4, 6, 7, 8);
c: array[1..7] of integer = (6, 2, 5, 4, 6, 3, 7);
fi, fo: text;


procedure open_file(s: string);
begin
assign(fi, s + '.INP'); reset(fi);
assign(fo, s + '.OUT'); rewrite(fo);
end;
procedure close_file;
begin
close(fi);
close(fo);
end;


procedure write_max(x: integer);
begin
if x mod 2 = 1 then begin
write(fo, 7);
dec(x, 3);
end;
write(fo, stringofchar('1', x div 2));
end;
procedure write_min(x: integer);
var s, i, f: integer;
begin
s := (x + 6) div 7;
if s = 1 then f := 0
else f := 1;
while s <> 0 do
for i := f + 1 to 7 do
if (x - c[i] >= 2*(s - 1)) and (x - c[i] <= 7*(s - 1)) then begin
write(fo, a[i]);
dec(x, c[i]);
dec(s);
f := 0;
break;
end;
end;


begin
open_file('QUEDIEM');


read(fi, n);
write_max(n);
write(fo, '-');
write_min(n);


close_file;
end.

// Bài 4 (TVH).
var
n, k, l, r, d: longint;
s: string;
fi, fo: text;


procedure open_file(s: string);
begin
assign(fi, s + '.INP'); reset(fi);
assign(fo, s + '.OUT'); rewrite(fo);
end;
procedure close_file;
begin
close(fi);
close(fo);
end;


begin
open_file('TVH');


read(fi, n, k);
l := 1; r := 10; d := 1;
while k >= d do begin
k -= d;
inc(l);
if l = r then begin
r *= 10;
inc(d);
end;
end;


str(l, s);


if k = 0 then
write(fo, (l + 9) mod 10)
else
write(fo, s[k]);


close_file;
end.

// Bài 5 (ROBOT).
var
n, x: integer;
i, j: integer;
a: array[1..50, 1..50] of string;
fi, fo: text;


procedure open_file(s: string);
begin
assign(fi, s + '.INP'); reset(fi);
assign(fo, s + '.OUT'); rewrite(fo);
end;

procedure close_file;
begin
close(fi);
close(fo);
end;


function min(a, b: string): string;
begin
if a <= b then
exit(a);
exit(b);
end;


begin
open_file('ROBOT');


readln(fi, n);
for i := 1 to n do
for j := 1 to n do begin
read(fi, x);
str(x, a[i][j]);
end;


for i := 2 to n do begin
a[1, i] := a[1, i - 1] + a[1, i];
a[i, 1] := a[i - 1, 1] + a[i, 1];
end;
for i := 2 to n do
for j := 2 to n do
a[i, j] := min(a[i - 1, j], a[i, j - 1]) + a[i, j];


write(fo, a[n, n]);


close_file;
end.

Bài làm của bạn @TRẦN MINH HOÀNG

Câu 1:

var M,N,i,j,i1:byte;dem,p, Min:integer;

A:Array[1..100,1..100] of integer;

fi,fo:text;

begin

assign(fi,'ptyn.inp');

reset(fi);

assign(fo,'ptyn.out');

rewrite(fo);

read(fi,M);

read(fi,N);

for i:=1 to M do

for j:=1 to N do

read(fi,A[i,j]);

dem:=0;

for i:=1 to M do

begin

Min:=A[i,1];

for j:=1 to N do

if A[i,j]<Min then Min:=A[i,j];

for j:=1 to N do

if A[i,j]=Min then

begin

p:=1;

for i1:=1 to M do if A[i1,j]>A[i,j] then begin p:=0; break end;

if p=1 then begin write(fo,i,' ',j); dem:=dem+1 end;

end;

end;

if dem=0 then write(fo,'Khong co phan tu yen ngua');

close(fi);

close(fo);

end.

Câu 2:

var n,i,j,k,doi,B:longint; Si,Sj,S1,S2:string;

A:Array[1..1000000] of longint;

fi,fo:text;

function LCM(a,b:longint):longint;

var LM:longint;

begin

LM:=1;

while ((LM mod a)<>0) OR ((LM mod b)<>0) do LM:=LM+1;

LCM:=LM;

end;

begin

assign(fi,'connect.inp');

reset(fi);

assign(fo,'connect.out');

rewrite(fo);

readln(fi,n);

for i:=1 to n do readln(fi,A[i]);

for i:=1 to n-1 do

for j:=i+1 to n do

begin

STR(A[i],S1);

STR(A[j],S2);

Si:='';Sj:='';

B:=LCM(length(S1),length(S2));

for k:=1 to ROUND(B/length(S1)) do Si:=Si+S1;

for k:=1 to ROUND(B/length(S2)) do Sj:=Sj+S2;

if Si<Sj then begin doi:=A[i];A[i]:=A[j];A[j]:=doi end;

end;

for i:=1 to n do write(fo,A[i]);

close(fi); close(fo);

end.

Câu 4:

var n,k,i:longint;

S:ansistring;

S1:string;

fi,fo:text;

begin

assign(fi,'tvh.inp');

reset(fi);

assign(fo,'tvh.out');

rewrite(fo);

read(fi,n); read(fi,k);

S:='';

for i:=1 to n do

begin

STR(i,S1);

S:=S+S1;

end;

write(fo,S[k]);

close(fi);

close(fo);

end.

Bài làm của bạn @Luân Đào(bạn được 2,8 điểm)

program b1;

uses crt;

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

i,j,m,n:integer;

f1,f2:text;

Max, Min:Integer;

Kt:boolean;

Procedure XuatMang;

begin

For i:=1 to n do

begin

for j:=1 to m do

Write(a[i,j]:4);

Writeln;

end;

end;

Procedure MaxCot(l:Integer);

var p:Integer;

begin

Max:=A[1,l];

For p:=2 to n do

if A[p,l]>Max then Max:=A[p,l];

end;

Procedure MinHang(k:Integer);

var o:integer;

begin

Min:=A[k,1];

For o:=2 to n do

if A[k,o]<Min then Min:=A[k,o];

end;

begin

clrscr;

assign(f1,'ptyn.inp');

assign(f2,'ptyn.out');

reset(f1);rewrite(f2);

while not EOF(f1) do

begin

kt:=false;

readln(f1,n,m);

for i:=1 to n do

begin

for j:=1 to m do

Read(f1,a[i,j]);

readln(f1);

end;

for i:=1 to n do

begin

for j:=1 to n do

begin

MaxCot(j);

MinHang(i);

if Max=Min then

begin

Writeln(f2,i,',',j,' la phan tu yen ngua.');

kt:=true;

end;

end;

end;

if kt=false then Writeln(f2,'Khong co phan tu yen ngua.');

end;

Close(f1); Close(f2);

Readln;

End.

program b2;

uses crt;

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

b:array[1..100] of string;

i,j,n:longint;

tam:string;

f1,f2:text;

begin

assign(f1,'connect.inp');

reset(f1);

assign(f2,'connect.out');

rewrite(f2);

readln(f1,n);

for i:=1 to n do

read(f1,a[i]);

for i:=1 to n do

str(a[i],b[i]);

tam:='';

for i:=1 to n do

for j:=i+1 to n do

if b[i]<b[j] then

begin

tam:=b[i];

b[i]:=b[j];

b[j]:=tam;

end;

for i:=1 to n do

write(f2,b[i]);

close(f1);

close(f2);

end.

program b4;

var n,b,dem,sl,s2,s3,s4,s5,s6,s7,k,i,b1: longint;

st,s1,sk:string;

f1,f2: text;

procedure ip;

begin

assign(f1,'C:\FPC\3.0.4\bin\i386-win32\tvh.inp');

reset(f1);

read(f1,n,k);

close(f1);

end;

procedure op;

begin

assign(f2,'C:\FPC\3.0.4\bin\i386-win32\tvh.out');

rewrite(f2);

str(n,st);

b:=length(st);

case b of

1: write(f2,'9');

2: begin

sl:=n-9;

dem:=9+sl*2;

end;

3: begin

s2:=(99-10)+1;

s3:=n-99;

dem:=9+s2*2+s3*3;

end;

4: begin

s2:=99-10+1;

s3:=999-100+1;

s4:=n-999;

dem:=9+s2*2+s3*3+s4*4;

end;

5: begin

s2:=99-10+1;

s3:=999-100+1;

s4:=9999-1000+1;

s5:=n-9999;

dem:=9+s2*2+s3*3+s4*4+s5*5;

end;

6: begin

s2:=99-10+1;

s3:=999-100+1;

s4:=9999-1000+1;

s5:=99999-10000+1;

s6:=n-99999;

dem:=9+s2*2+s3*3+s4*4+s5*5+s6*6;

end;

7: begin

s2:=99-10+1;

s3:=999-100+1;

s4:=9999-1000+1;

s5:=99999-10000+1;

s6:=n-999999;

dem:=9+s2*2+s3*3+s4*4+s5*5+s6*6+s7*7;

end;

end;

if k>=dem then

begin

i:=1;

b1:=0;

repeat

str(i,s1);

b1:=b1+length(s1);

i:=i+1;

until b1>=k;

sk:=s1[length(s1)-(b1-k)];

write(f2,sk);

close(f2);

end;

end;

begin

ip;

op;

end.

program b5;

const fi = 'robot.inp';

fo = 'robot.out';

var f1,f2: text;

n,x,i,j: integer;

A: array[1..50,1..50] of string;

procedure ip;

begin

assign(f1,fi);

reset(f1);

read(f1,n);

close(f1);

end;

procedure op;

begin

for i:=1 to n do

for j:=1 to n do

begin

read(f1,x);

str(x,a[i][j]);

end;

for i:=2 to n do

begin

a[1,i]:=a[1,i-1]+a[1,i];

a[i,1]:=a[i-1,1]+a[i,1];

end;

for i:=2 to n do

for j:= 2 to n do

a[i,j]:= min(a[i-1,j],a[i,j-1]+a[i,j]);

assign(f2,fo);

rewrite(f2);

write(f2,a[n,n]);

close(f2);

end;

begin

ip;

op;

end.