Tệp và thao tác với tệp

Nguyễn Lê Phước Thịnh

ĐÁP ÁN VÒNG 1 CUỘC THI TIN HỌC LẦN 2

Câu 1:

const fi='ptyn.inp'
fo='ptyn.out'
var a:array[1..100,1..100]of integer;
i,j,n,m,snn,sln,vtc,vth,x,z,kt,k,dem:integer;
f1,f2:text;
begin
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
readln(f1,n,m);
for i:=1 to n do
for j:=1 to m do
read(f1,a[i,j]);
{----------nho nhat hang----------}
dem:=0;
for i:=1 to n do
begin
snn:=a[i,1];
for j:=1 to m do
if snn>=a[i,j] then
begin
snn:=a[i,j];
vth:=i;
vtc:=j;
end;
kt:=0;
sln:=a[vth,vtc];
for k:=1 to n do
if sln<a[k,vtc] then kt:=1;
if kt=0 then
begin
writeln(f2,vth,' ',vtc);
dem:=dem+1;
end;
end;
if dem=0 then writeln(f2,'Khong co phan tu yen ngua');
close(f1);
close(f2);
end.

Câu 2: Bài làm của bạn @Tran Nguyễn Đăng Dương

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.

Câu 3:

const fi='quediem.inp'
fo='quediem.out'
var f1,f2:text;
i,m,n,d,x,j,csc:longint;
a,b:array[1..100]of integer;
begin
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
readln(f1,n);
{---------------------------tim-so-lon-nhat----------------------------}
m:=n;
if m mod 2=0 then
begin
for i:=1 to n div 2 do
write(f2,'1');
end
else begin
write(f2,'7');
for i:=2 to n div 2 do
write(f2,'1');
end;
{---------------------------tim-so-nho-nhat----------------------------}
write(f2,'-');
a[1]:=2; b[1]:=1;
a[2]:=5; b[2]:=2;
a[3]:=4; b[3]:=4;
a[4]:=6; b[4]:=6;
a[5]:=3; b[5]:=7;
a[6]:=7; b[6]:=8;
d:=(n div 7)+1;
if n mod 7=0 then d:=d-1;
if d=1 then
begin
case n of
2: write(f2,'1');
3: write(f2,'7');
4: write(f2,'4');
5: write(f2,'2');
6: write(f2,'0');
7: write(f2,'8');
end;
end;
if d>1 then
begin
for i:=1 to d do
if i=1 then
begin
b[4]:=6;
for j:=1 to 6 do
begin
x:=n;
x:=x-a[j];
csc:=(x div 7)+1;
if x mod 7=0 then dec(csc);
if csc=d-i then
begin
write(f2,b[j]);
n:=x;
break;
end;
end;
end
else begin
a[1]:=6; b[1]:=0;
a[2]:=2; b[2]:=1;
a[3]:=5; b[3]:=2;
a[4]:=4; b[4]:=4;
a[5]:=3; b[5]:=7;
a[6]:=7; b[6]:=8;
for j:=1 to 6 do
begin
x:=n;
x:=x-a[j];
csc:=(x div 7)+1;
if x mod 7=0 then csc:=csc-1;
if csc=d-i then
begin
write(f2,b[j]);
n:=x;
break;
end;
end;
end;
end;
close(f1);
close(f2);
end.

Câu 4:

const fi='tvh.inp'
fo='tvh.out'
var n,d,dem,sl,s2cs,s3cs,s4cs,s5cs,s6cs,s7cs,s8cs,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-100000)+1;
s7cs:=n-999999;
dem:=9+s2cs*2+s3cs*3+s4cs*4+s5cs*5+s6cs*6+s7cs*7;
end;
8: begin
s2cs:=(99-10)+1;
s3cs:=(999-100)+1;
s4cs:=(9999-1000)+1;
s5cs:=(99999-10000)+1;
s6cs:=(999999-100000)+1;
s7cs:=(9999999-1000000)+1;
s8cs:=n-9999999;
dem:=9+s2cs*2+s3cs*3+s4cs*4+s5cs*5+s6cs*6+s7cs*7+s8cs*8;
end;
end;
if k<=dem then
begin
i:=1;
d1:=0;
repeat
str(i,st1);
d1:=d1+length(st1);
inc(i);
until d1>=k;
stk:=st1[length(st1)-(d1-k)];
writeln(f2,stk);
end;
close(f1);
close(f2);
end.

Câu 5: Bài làm của bạn @Tran Nguyễn Đăng Dương

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.

Nguyễn Lê Phước Thịnh
14 tháng 8 2020 lúc 20:00

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.

Bình luận (0)
Nguyễn Lê Phước Thịnh
14 tháng 8 2020 lúc 20:02

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.

Bình luận (0)
Nguyễn Lê Phước Thịnh
14 tháng 8 2020 lúc 20:03

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ình luận (0)
Nguyễn Lê Phước Thịnh
14 tháng 8 2020 lúc 20:11

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ình luận (0)
Nguyễn Lê Phước Thịnh
14 tháng 8 2020 lúc 20:12

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ình luận (0)
Nguyễn Lê Phước Thịnh
14 tháng 8 2020 lúc 20:12

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ình luận (0)
Nguyễn Lê Phước Thịnh
14 tháng 8 2020 lúc 20:13

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ình luận (0)

Các câu hỏi tương tự
CỦ CẢI
Xem chi tiết
Nguyễn Thị Ngọc Hà
Xem chi tiết
Ưu Vô
Xem chi tiết
Nguyễn Thái Sơn
Xem chi tiết
Nguyễn Lê Phước Thịnh
Xem chi tiết
Nguyễn Lê Phước Thịnh
Xem chi tiết
Anh Nguyen
Xem chi tiết
New wibu
Xem chi tiết
0o0 Nhok kawaii 0o0
Xem chi tiết